使用 VBA 根据可变图纸编号创建多个 pivot 表

Question

我有一个带有许多工作表的工作簿，所有工作簿都包含如下表格：

供应商	类别	合约编号	文件名称	分数
A公司	衣服	ABC27123	合同名称_1	80%
A公司	衣服	ABC27123	合同名称_2	35%
B公司	电信	DB21HG3A	合同_7	77%
公司 C	汽车	9HRT76X1	Contract_signed_1	56%
公司 C	汽车	9HRT76X1	合同_修改	90%
公司 C	汽车	9HRT76X1	Contract_reviewed_2	45%

包含这些表格的所有工作表的标题为Lever 1 、 Lever 2 、 Lever 3等。 表格也以表格命名（即Lever_1 、 Lever_2 、 Lever_3等）。 工作表的数量因用例而异，但其中的数据将始终采用与上述相同的格式。

我正在尝试创建一个脚本，该脚本将创建一个名为Pivots的新工作表，其中将为每个Lever工作表创建一个 pivot 表。 Pivot 表应使用列Contract ID和Document Name作为行，并使用Max of Score作为值。 我在下面附上了一个例子。

谁能帮我指出正确的方向？ 我是 VBA 的新手，我不确定从哪里开始。

Answer 1

试试看，前提是每张表的数据都来自单元格a1。

Sub test()
    Dim Wb As Workbook
    Dim Ws As Worksheet, pWs As Worksheet
    Dim vName() As Variant
    Dim rngDB As Range
    Dim pc As PivotCache
    Dim pv As PivotTable
    Dim Fd As PivotField
    Dim n As Integer
    Dim Target As Range
    
    Set Wb = ThisWorkbook
    
    Application.DisplayAlerts = False
    For Each Ws In Worksheets
        If InStr(Ws.Name, "Pivot") Then
            n = n + 1
            ReDim Preserve vName(1 To n)
            vName(n) = Ws.Name
        End If
    Next Ws
    
    If n Then
        Worksheets(vName).Delete
    End If
    Application.DisplayAlerts = True
    
    n = 0
    For Each Ws In Worksheets
        If InStr(Ws.Name, "Lever") Then
            n = n + 1
           
            Set rngDB = Ws.Range("a1").CurrentRegion
            Set pWs = Worksheets.Add(after:=Sheets(Sheets.Count))

            With pWs
                .Name = "Pivot " & n
                Set Target = .Range("a1")
            End With
            
            Set pc = Wb.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=rngDB)
            Set pv = pc.CreatePivotTable(TableDestination:=Target, TableName:="Pivot " & n)
            With pv
                Set Fd = .PivotFields("Contract ID")
                With Fd
                    .Orientation = xlRowField
                    .Position = 1
                End With
                Set Fd = .PivotFields("Document Name")
                With Fd
                    .Orientation = xlRowField
                    .Position = 2
                End With
                Set Fd = .PivotFields("Score")
                With Fd
                    .Orientation = xlDataField
                    .Function = xlMax
                    .Position = 1
                End With
            End With
        End If
    Next Ws
                
End Sub