标签：Excel学习,excel视频教程,http://www.qiuzhi56.com 对多个工作簿进行合并计算（求和）一例,http://www.qiuzhi56.com

 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

[1] [2]  下一页

，对多个工作簿进行合并计算（求和）一例