L oop через фильтр в сводной таблице - PullRequest
Новая
       8

L oop через фильтр в сводной таблице

0 голосов
/ 25 мая 2020

Я новичок в VBA и пытаюсь написать код, который, кажется, не понимаю.

Чего я пытаюсь достичь:

У меня есть сводная таблица с одной строкой и поле столбца. Есть один фильтр с более чем 50 вариантами. Это ячейка c2 на изображении. Также ниже выполняется простой расчет, который зависит от значений в сводной таблице. Это в ячейках c47: j47. Я хотел бы создать код, который просматривает все параметры в фильтре и копирует результаты простых вычислений в новую электронную таблицу (Sheet5) вместе с заголовком параметра фильтра.

Итак, в Sheet5 ячейка c2 из Pivot (2) копируется в ячейку A1, а c47: j47 из Pivot (2) копируется в B1: H1 в Sheet5 для первого параметра в фильтре, а затем он переходит ко второму варианту в фильтр и вставляет результаты ниже. Пожалуйста, посмотрите картинку здесь.

Кто-нибудь сможет мне с этим помочь? Это мой код ниже. Я получаю сообщение об ошибке: не удается получить свойство PivotFields класса сводной таблицы. 

Sub PivotStockItems() 
Dim i As Integer 
Dim sItem As String 
Dim pivotSht As Worksheet, dataSht As Worksheet
Set pivotSht = Sheets("Pivot (2)") 
Set dataSht = Sheets("Sheet5") 
Application.ScreenUpdating = False
With pivotSht.PivotTables("CummulativeClaims")
    .PivotCache.MissingItemsLimit = xlMissingItemsNone
    .PivotCache.Refresh
    With .PivotFields("Yes")
        .PivotItems(1).Visible = True
        For i = 2 To .PivotItems.Count
            .PivotItems(i).Visible = False
        Next
        For i = 1 To .PivotItems.Count
            .PivotItems(i).Visible = True
            If i <> 1 Then .PivotItems(i - 1).Visible = False
            sItem = .PivotItems(i)

            'this takes care of the condition and copy-pasting
            If pivotSht.Range("c47").Value > 0 Then
                dataSht.Cells(getLastFilledRow(dataSht) + 1, 1).Value = sItem
                dataSht.Cells(getLastFilledRow(dataSht), 2).Value = pivotSht.Range("c47:j47").Value
            Else: End If

        Next i
    End With
End With
End Sub

Public Function getLastFilledRow(sh As Worksheet) As Integer 
On Error Resume Next 
getLastFilledRow = sh.Cells.Find(What:="*", _ 
                   After:=sh.Range("A1"), _ 
                   LookAt:=xlPart, _ 
                   LookIn:=xlValues, _ 
                   SearchOrder:=xlByRows, _ 
                   SearchDirection:=xlPrevious, _ 
                   MatchCase:=False).Row 
     On Error GoTo 0 
End Function
...