Excel中的合并计算可以对多个工作表的对应项目进行求和、求平均值等计算,但如果需要合并计算的工作表较多,特别是这些工作表位于不同的工作簿内时,逐一选择数据源显得较为繁琐。用VBA中的Range.Consolidate方法可以快速地对多个结构相似的工作表进行合并计算,但如果表格内包含有非数值类型的数据列,合并计算会忽略这些列。例如下图为某个图书销售点1至12月的图书销售记录,销售数量位于D至O列,其中B列和C列为与A列对应的数据,无需参与合并计算,但必须在汇总表中列出。各销售点都有一个类似的销售表格,每个分表列出的图书数量不等,图书名称也不尽相同。现在需要对各销售点的销售表格中D至O列的销售数量按照A列图书名称进行合计,求出总的销售数量。
如果直接使用合并计算,Excel会忽略B列文本,同时对C列(单价)也进行合并计算,显然不符合要求。这时使用VBA中的Dictionary对象,可以解决这一问题,代码如下:
Sub SumWorkbooks()
Dim ThePath As String, TheFile As String
Dim d As Object, Wbk As Workbook
Dim i As Integer, j As Integer, k As Integer
Dim Arr1(11), Arr2(), Arr3(), dk
On Error Resume Next
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
ThePath = ThisWorkbook.Path & "\"
TheFile = Dir(ThePath & "*.xls")
Do While TheFile <> ""
If TheFile <> ThisWorkbook.Name Then
Set Wbk = GetObject(ThePath & TheFile)
With Wbk.Worksheets(1)
For i = 2 To .Range("A65536").End(xlUp).Row
'将D至O列数值赋值给Arr1
For j = 0 To 11
Arr1(j) = .Cells(i, j + 4).Value
Next j
If Not d.exists(.Range("A" & i).Value) Then
'key对应一个数组
d.Add .Range("A" & i).Value, Arr1
'将不能求和的数据赋值给Arr2
ReDim Preserve Arr2(1 To 2, 1 To k + 1)
For j = 1 To 2
Arr2(j, k + 1) = .Cells(i, j + 1)
Next j
k = k + 1
Else
For j = 0 To 11
'若数据存在则D至O列数值对应合计到Arr1中的每个元素
Arr1(j) = d(.Range("A" & i).Value)(j) + Arr1(j)
Next
d(.Range("A" & i).Value) = Arr1
End If
Next
End With
Wbk.Close False
End If
TheFile = Dir '当前文件夹内的下一个工作簿
Loop
'输出
With ThisWorkbook.Worksheets(1)
.Range("A2").Resize(d.Count, 1) = Application.Transpose(d.keys)
dk = d.keys
ReDim Arr3(1 To d.Count, 1 To 12)
For i = 0 To d.Count - 1
For j = 0 To 11
Arr3(i + 1, j + 1) = d(dk(i))(j)
Next j
Next i
.Range("D2:O" & d.Count + 1).Value = Arr3
.Range("B2:C" & d.Count + 1).Value = Application.Transpose(Arr2)
End With
Set d = Nothing
Application.ScreenUpdating = True
End Sub
在汇总表中按Alt+F11,打开VBA编辑器,单击菜单“插入→模块”,粘贴上述代码并运行,即可对汇总工作簿所在的文件夹内的其他所有工作簿的第一个工作表进行合并求和,无需打开各个需要汇总的工作簿。汇总后的B、C两列为与A列对应的数据。汇总前须注意以下几点:
1.将汇总工作簿和其他各个工作簿放到同一文件夹内,并保存汇总工作簿。汇总前移走文件夹内所有无关工作簿。
2.各分表应位于各工作簿中的最左侧(第一个)。
3.各分表内的记录数量可以不同,但行标题需相同。 |