Интересный вопрос :) Надеюсь, я правильно понял ваш запрос: 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
Надеюсь, это то, что вы хотели?Если нет, то сообщите мне, и я внесу в него поправки.
Образец рабочей книги можно загрузить по адресу здесь .Эта ссылка будет действовать в течение 7 дней.
HTH
Sid