首页 > 代码库 > [VBA]汇总多个工作簿的指定工作表到同一个工作簿的指定工作表中
[VBA]汇总多个工作簿的指定工作表到同一个工作簿的指定工作表中
sub 汇总多个工作簿()
Application.ScreenUpdating = False
Dim wb As Workbook, f As String, l As String, n As String, m As String, j As Integer
f = ThisWorkbook.Path & "\"
l = f & "*.xls"
m = Dir(l)
Do While m <> ""
If m <> ThisWorkbook.Name Then
n = f & m
Workbooks.Open (n)
With ThisWorkbook.activesheet
.Range("b4:at34").ClearContents
For i = 4 To .Range("a1").CurrentRegion.Rows.Count
For j = 2 To .Range("a1").CurrentRegion.Columns.Count - 2 Step 3
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then
aa = Left(wb.Name, InStrRev(wb.Name, ".") - 1)
If .Cells(2, j).Value = http://www.mamicode.com/aa Then
.Cells(i, j) = Application.VLookup(.Cells(i, 1), wb.Worksheets(1).Range("a:b"), 2, 0)
.Cells(i, j + 1) = Application.VLookup(.Cells(i, 1), wb.Worksheets(1).Range("a:c"), 3, 0)
If VBA.IsNumeric(ThisWorkbook.activesheet.Cells(i, j + 1)) = False Then
ThisWorkbook.activesheet.Cells(i, j + 2) = 0
ElseIf ThisWorkbook.activesheet.Cells(i, j + 1) = 0 Then
ThisWorkbook.activesheet.Cells(i, j + 2) = 0
Else
ThisWorkbook.activesheet.Cells(i, j + 2) = ThisWorkbook.activesheet.Cells(i, j) / ThisWorkbook.activesheet.Cells(i, j + 1)
End If
End If
End If
Next
Next
Next
End With
End If
m = Dir
Loop
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then
wb.Close False
End If
Next
Application.ScreenUpdating = True
End Sub
效果图：
不足：
调用excel本身的函数vlookup，数据量大的话，会导致运行速度慢，表格卡住的问题，后期优化，应用数组解决。
[VBA]汇总多个工作簿的指定工作表到同一个工作簿的指定工作表中