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

汇总表格式

详情表格式

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

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

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

Sub Start()
    Sheet1.UsedRange.Clear
    
    '定义结果数组
    Dim detail
    
    '计算过程中屏幕不刷新
    Application.ScreenUpdating = False
    'm表示当前detail数组中已有的元素个数
    m = 1
    '定义一个大数组，用于放置结果
    ReDim detail(1 To 10000, 1 To 2)
    '结果的表头
    detail(1, 1) = "物料代码"
    detail(1, 2) = "数量"
    '当前工作簿所在地址
    p = ThisWorkbook.Path & ""
    '打开汇总表
    Set sumsheet = GetObject(p & "汇总.xlsx").Sheets(1)
    '获取汇总表中的内容
    rng = sumsheet.UsedRange
    '对汇总表中的内容，从第二行开始循环
    For i = 2 To UBound(rng)
        '获取详细表的名称
        fileName = rng(i, 1) & ".xls"
        '获取板卡数量
        bandCount = rng(i, 2)
        '获取详细信息的excel对象
        Set excelobj = GetObject(p & fileName)
        '获取详细信息所在的sheet
        Set sdetail = excelobj.Sheets(1)
        '获取sheet中数据
        arr = sdetail.UsedRange
        '释放excel
        Set excelobj = Nothing
        '对于每一条详细信息做循环，j=1是表头
        For j = 2 To UBound(arr)
           
             '在已有的数据中找到重复项
            For k = 2 To m
                '如果结果中存在相同项
                If detail(k, 1) = arr(j, 1) Then
                    '对数量进行求和
                    detail(k, 2) = detail(k, 2) + arr(j, 3) * bandCount
                    '进入下一次循环
                    GoTo n
                End If
                
            Next
            'm表示当前detail数组中已有的元素个数
             m = m + 1
            '累计detail用m
            '取物料代码
            detail(m, 1) = arr(j, 1)
            '计算物料数量
            detail(m, 2) = arr(j, 3) * 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, 2)) = 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 = 1
        '建立透视表缓存数据
        Set ptcache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=Sheet1.UsedRange)
        '建立透视表,TableDestination用于指定 创建表的位置,wps这个参数好像没用，一直都会新建一个表，并以A1单元格为左上角定位
        Set pt = ptcache.CreatePivotTable(TableDestination:=Sheet1.Range("D10"), TableName:=TableName, DefaultVersion:=1)

    '将物料代码作为行字段
    With ActiveSheet.PivotTables(TableName).PivotFields("物料代码")
        .Orientation = xlRowField
        .Position = 1
        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