汇总表格式

详情表格式

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

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

 

 

 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