итерация по произвольному количеству сводных полей - PullRequest
0 голосов
/ 19 февраля 2012

У меня есть несколько сценариев VBA, которые перебирают элементы Pivot внутри поля Pivot, но я хотел бы иметь возможность использовать их независимо от количества имеющихся полей. Как я могу это сделать?

Например, у меня могут быть два поля строки (например, {abcd} для поля строки один и {AB} для поля строки два. Как я могу перебрать все возможные комбинации текущих полей? Это будет означать, что Я бы получил {aA aB bA bB cA cB dA дБ}. Однако решение должно быть гибким, чтобы, если бы у меня было четыре поля (например, {ab} {AB} {1 2} {! @}) Или шесть (которые я не могу легко визуализировать) Я мог бы получить все их комбинации (например, {aA1! aA1 @ aA2! ... bB1 @ bB2! bB2@ Event.

В идеале, решение должно было бы не просто дать мне набор строк, которые указывают каждое из имен, но что-то, что я могу выполнить, когда оно повторяет набор.

Я могу представить себе немного сложную установку, где у меня есть массив индексов, цикл операций, функция, которая увеличивает массив индексов, и функция, которая проверяет, был ли достигнут счетчик терминалов. Есть ли способ лучше? Кроме того, единственный ли способ, которым я могу использовать это через функции листа?

1 Ответ

0 голосов
/ 19 февраля 2012

Интересный вопрос :) Надеюсь, я правильно понял ваш запрос: 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 сводных полей.

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

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...