如何使用Excel VBA：为不同的工作表创建数据透视表，将数据透视表扩展到新工作簿并使用特定名称保存

Question

我正在寻找一个宏来每次都对新数据执行这些步骤。步骤是：

步骤1）为包含新数据的每张工作表创建数据透视表

• 每个新数据加载（即表格）可能会有所不同 由国家）
分隔和命名

• 每张纸上的列数不同

• 透视显示：属于1个标题的值的计数（例如

）

Fig 1: Sample data - 5 "Countries" on 5 sheets > Pivot to show highlighted columns. Example: Worksheet "MY" showing 9 "Categories". With 5 "Country" sheets, we should have 5 separate pivots

步骤2）按行扩展到新工作簿（例如3 Categories 转换为3个包含 SKU 数据的新工作簿）

• 每个数据透视表中类别的数量可能会有所不同

Fig 2: Sample new worksheet from "MY" sheet's "EL" category with 3K SKUs -> wish to move to new workbook// Total number of new workbooks should be 5 Countries * X Categories per Country

步骤3）将这些新工作簿保存为特定名称和格式，具体取决于它的扩展范围（即Country_Category.scsv）

• 对于名称：国家/地区是第1步中的工作表被命名/或者pls建议如何最好地格式化我的数据，这样更容易。 类别是从
扩展出来的
• 格式：数据中不存在逗号，可以使用全部替换“，”到“;”如果这有用吗？

- ＆GT;在这种情况下，预期的样本输出：MY_EL.scsv //所有国家和类别的类似：MY_FA.scsv，MY_HA.scsv ... TH_EL.scsv，TH_HA.scsv等......

我根本没有任何创建宏的背景，甚至无法解读我在本论坛上发布的部分示例代码，以便能够根据我的需要进行自定义。

提前感谢您，如果有人为这些步骤中的任何一个做出答案，我将不胜感激！

这是第2步和第3步的部分，它只使用一次来扩展枢轴和名称。它仍然缺少以分号分隔的格式，以及第1步：创建数据透视表，它也不再起作用。

Sub parse_data()
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    vcol = 10
    Set ws = Sheets("Sheet1")
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:J1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 To lr
        On Error Resume Next
        If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
            ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
        End If
    Next
    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).Clear
    For i = 2 To UBound(myarr)
        ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
        If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
        Else
            Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
        End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Sheets(myarr(i) & "").Columns.AutoFit
    Next
    ws.AutoFilterMode = False
    ws.Activate
End Sub

Sub Splitbook()
    Dim xPath As String
    xPath = Application.ActiveWorkbook.Path
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each xWs In ThisWorkbook.Sheets
        xWs.Copy
        Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".csv"
        Application.ActiveWorkbook.Close False
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub