迭代任意數量的數據透視表字段

Question

我有幾個VBA腳本迭代數據透視字段中的數據透視表項，但我希望能夠使用它們，而不管字段的數量是多少。我怎樣才能做到這一點？

例如，我可能在某個時間有兩個行字段（例如，{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

比方說，我們有這樣的支點？

所以，如果你想要的結果這樣

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個數據透視字段，則必須更改它。

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

希德