利用Excel-Vba进行多表汇总和数据透视表

汇总表格式

详情表格式

要求根据汇总表中的信息，到详情表中查找详细物料的具体个数

最终，对物料的个数进行汇总，结果如下图：

ExcelVba代码如下(有一些注释代码供参考)

Sub Start()
    Sheet1.UsedRange.Clear

    '定义结果数组
    Dim detail

    '计算过程中屏幕不刷新
    Application.ScreenUpdating = False
    'm表示当前detail数组中已有的元素个数
    m =
    '定义一个大数组，用于放置结果
    ReDim detail( To ,  To )
    '结果的表头
    detail(, ) = "物料代码"
    detail(, ) = "数量"
    '当前工作簿所在地址
    p = ThisWorkbook.Path & "\"
    '打开汇总表
    Set sumsheet = GetObject(p & "汇总.xlsx").Sheets()
    '获取汇总表中的内容
    rng = sumsheet.UsedRange
    '对汇总表中的内容，从第二行开始循环
    For i =  To UBound(rng)
        '获取详细表的名称
        fileName = rng(i, ) & ".xls"
        '获取板卡数量
        bandCount = rng(i, )
        '获取详细信息的excel对象
        Set excelobj = GetObject(p & fileName)
        '获取详细信息所在的sheet
        Set sdetail = excelobj.Sheets()
        '获取sheet中数据
        arr = sdetail.UsedRange
        '释放excel
        Set excelobj = Nothing
        '对于每一条详细信息做循环，j=1是表头
        For j =  To UBound(arr)

             '在已有的数据中找到重复项
            For k =  To m
                '如果结果中存在相同项
                If detail(k, ) = arr(j, ) Then
                    '对数量进行求和
                    detail(k, ) = detail(k, ) + arr(j, ) * bandCount
                    '进入下一次循环
                    GoTo n
                End If

            Next
            'm表示当前detail数组中已有的元素个数
             m = m +
            '累计detail用m
            '取物料代码
            detail(m, ) = arr(j, )
            '计算物料数量
            detail(m, ) = arr(j, ) * bandCount

'goto 跳出本次循环
n:
        Next

    Next
'   循环遍历文件
'    Do While f <> ""
'        If f <> ThisWorkbook.Name Then
'             n = n + 1
'             Set sht = GetObject(p & f).Sheets(1)
'             Arr = sht.UsedRange
'             Workbooks(f).Close False
'             For i = 1 To UBound(Arr)
'                 m = m + 1
'                 brr(m, 1) = f
'                 For j = 2 To r
'                     brr(m, j) = Arr(i, j - 1)
'                 Next
'              Next
'         End If
'         f = Dir
'    Loop

    Set sumsheet = Nothing
    With Sheet1
        .[a1].Resize(m, UBound(detail, )) = detail
    End With

'    Range("A2").Select
'    ActiveWindow.ScrollRow = 1
'    'Sheets.Add
'    ActiveWorkbook.PivotCache.CreatePivotTable TableDestination:="Sheet2!R3C1", TableName:="数据透视表3", DefaultVersion:=1
'    Range("A3").Activate
'    ActiveSheet.PivotTable.AddDataField Field:=ActiveSheet.PivotTable.PivotField
'    With ActiveSheet.PivotTable.PivotField
'        .Orientation = xlRowField
'        .Position = 1
'    End With

' Call BuildPivotTable
    Application.ScreenUpdating = True
End Sub

'创建数据透视表
Sub BuildPivotTable()

    TableName = "数据透视表5"

    ActiveWindow.ScrollRow =
        '建立透视表缓存数据
        Set ptcache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=Sheet1.UsedRange)
        '建立透视表,TableDestination用于指定 创建表的位置,wps这个参数好像没用，一直都会新建一个表，并以A1单元格为左上角定位
        Set pt = ptcache.CreatePivotTable(TableDestination:=Sheet1.Range("D10"), TableName:=TableName, DefaultVersion:=)

    '将物料代码作为行字段
    With ActiveSheet.PivotTables(TableName).PivotFields("物料代码")
        .Orientation = xlRowField
        .Position =
        End With

'        With ActiveSheet.PivotTables(TableName).PivotFields("数量")
'        .Orientation = xlColumnField
'        .Position = 1
'        End With

        '对数据透视表 添加数据字段datafield
        ActiveSheet.PivotTables(TableName).AddDataField ActiveSheet.PivotTables(TableName).PivotFields("数量"), "求和：数量", xlSum
End Sub