Question

我有几个VBA脚本迭代Pivot字段中的Pivot项目，但我希望能够使用它们，无论那里有多少个字段。我怎么能这样做？

例如，我可能在某个时间有两个行字段（例如{abcd}表示行字段1，{AB}表示字段2。如何迭代当前字段的所有可能组合？这意味着我会得到{aA aB bA bB cA cB dA dB}。但是，解决方案应该是灵活的，这样如果我有四个字段（例如{ab} {AB} {1 2} {！@}）或六个（我是不能轻易想象）我可以得到它的所有组合（例如{aA1！aA1 @ aA2！... bB1 @ bB2！bB2 @}。

理想情况下，解决方案不仅会给我一组表示每个名称的字符串，而且还会在迭代整个集合时执行。

我可以想象一个稍微复杂的设置，其中我有一个索引数组，一个do循环，一个递增索引数组的函数，以及一个检查是否已达到终端计数的函数。有没有更好的办法？另外，我可以通过工作表函数使用它的唯一方法吗？

Answer 1

有趣的问题:)希望我已正确理解您的查询：P

我们说我们有这样一个支点吗？

enter image description here

所以如果你想要这样的结果

AAAA

AAAB

AAAC

AAAD

BBBA

BBBB

BBBC

BBBD

CCCA

CCCB

CCCC

CCCD

DDDA

dddB

DDDC

DDDD

A1

A2

A3

A4

B1

B2

B3

B4

C1

C2

C3

C4

D1

D2

D3

D4

然后您可以使用此代码。此示例将数据输出到Col G（在本例中）。如果您有超过6个Pivot字段，则必须更改它。

Option Explicit

Sub Sample()
    Dim pvtField As PivotField
    Dim pvtItem As PivotItem
    Dim MyArray() As String
    Dim ws As Worksheet, wsTemp As Worksheet
    Dim i As Long, j As Long, k As Long, l As Long, m As Long
    Dim LastRow As Long, LastCol As Long, LastRowNC As Long

    '~~> Set ws to sheet which has the relevant pivot table
    Set ws = Sheets("Sheet1")
    ws.Activate

    '~~> Add a temp sheet for output
    Set wsTemp = Sheets.Add

    j = 0

    '~~> Loop through all pivot fields in the relevant pivot
    '~~> Change "PivotTable1" to the relevant pivot table name
    For Each pvtField In ws.PivotTables("PivotTable1").PivotFields
        i = 1
        j = j + 1
        For Each pvtItem In pvtField.PivotItems
            '~~> Output the Pivot items in a temp sheet
            With wsTemp
                .Cells(i, j).Value = pvtItem.Value
                i = i + 1
            End With
        Next
    Next

    '~~> Get the lastrow in the temp sheet
    LastRow = wsTemp.Cells.Find(What:="*", After:=wsTemp.[A1], SearchOrder:=xlByRows, _
              SearchDirection:=xlPrevious).Row
    '~~> Get the lastcol in the temp sheet
    LastCol = wsTemp.Cells.Find(What:="*", After:=wsTemp.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, _
              SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column

    m = 1: j = 0

    '~~> Create the necessary combinations
    With wsTemp
        For i = 1 To LastCol
            LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            If .Cells(1, i + 1) <> "" Then
                LastRowNC = .Cells(.Rows.Count, i + 1).End(xlUp).Row
                For k = 1 To LastRow
                    For l = 1 To LastRowNC
                        '~~> Output combinations in Col G
                        '~~> You will have to change this if you have
                        '~~> more than 6 pivot fields
                        .Range("G" & m).Value = .Cells(k, i) & .Cells(l, i + 1)
                        m = m + 1
                    Next
                Next
            End If
        Next i
    End With
End Sub

希望这是你想要的？如果没有，请告诉我，我会修改它。

可以从here下载示例工作簿。此链接将有效7天。

HTH

西特

迭代任意数量的枢轴字段

1 个答案: