利用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