如何将可见的数据透视项数据复制到 Excel VBA 中的单元格

Question

我在数据透视报告过滤器中有国家代码。我想获取可见的枢轴项数据并将每个值放在 A1 的每个单元格中。我使用了下面的代码。但所有单元格仅显示过滤器中的最后一个值。我需要从 A1 自动移动。帮帮我

Sub Getpivotitem()

Dim ws As Worksheet
Dim str1 As Variant
Dim Data As Variant
Dim rng As Range

Set rng = Range("A1:X1")
Set ws = Sheets("Sheet1")

Dim pi As PivotItem
For Each pi In ws.PivotTables("PivotTable1").PivotFields("Country Code").PivotItems
    If pi.Visible = True Then
        For Each cell In rng.Columns
        cell.Value = pi
        Next cell
     End If
Next pi

End Sub

Answer 1

您的输出是由嵌套循环引起的。我想这就是你要找的东西

Sub Getpivotitem()

    Dim ws As Worksheet
    Dim str1 As Variant, Data As Variant
    Dim pi As PivotItem
    Dim rng As Range
    Dim j As Long

    Set ws = Sheets("Sheet1")
    Set rng = Range("A1:X1")

    For Each pi In ws.PivotTables("PivotTable1").PivotFields("Country Code").PivotItems
        If pi.Visible = True Then
            j = j + 1
            ws.cells(1, j) = pi
        End If
    Next pi

End Sub

Answer 2

适用于 Excel 2010 或更高版本的非 VBA 方法：只需复制数据透视表，然后从中删除除国家代码字段外的所有字段。将 Country Code 字段移动到 ROWS 或 COLUMNS 窗格，并使用切片器连接两个数据透视表。 Bingo：您有一个列表，显示在数据透视表中所做的任何选择。更好的是，用户可以简单地使用切片器进行这些选择。

Answer 3

以下代码会将所有可见值从Country Code 列复制并粘贴到A1、B1、C1 ......单元格。

Sub CopyVisiblesValues()

    Sheet1.PivotTables("PivotTable1").PivotSelect "'Country Code'[All]", xlLabelOnly + xlFirstRow, True
        Selection.Copy
    Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

End Sub

这里Country Code 是数据透视表的列标题以及源数据的列标题。您可能需要调整Country Code。