Question

我正在使用Excel 2013，我有一个包含数百个过滤器值的数据透视表，我需要迭代它们，使每个过滤器值可单独显示，然后复制过滤后的值和特定单元格（非Pivot和IF＆gt; ; 0）并将其粘贴（仅限值）到指定的工作表中，然后移动到下一个透视项目并执行相同操作。我找到了一些类似于我想要的代码

Sub PivotStockItems()
Dim i As Integer
Dim sItem As String
Application.ScreenUpdating = False
With ActiveSheet.PivotTables("PivotTable1")
    .PivotCache.MissingItemsLimit = xlMissingItemsNone
    .PivotCache.Refresh
    With .PivotFields("Country")
        '---hide all items except item 1
        .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)
            Cells.Copy
            Workbooks.Add
            With ActiveWorkbook
                .Sheets(1).Cells(1).PasteSpecial _
                    Paste:=xlPasteValuesAndNumberFormats
                .SaveAs "C:\TEST\MyReport-" & sItem & ".xlsx", _
                    FileFormat:=xlOpenXMLWorkbook
                .Close
            End With
        Next i
    End With
End With

End Sub 但是，我知道我需要删除

Cells.Copy
        Workbooks.Add
        With ActiveWorkbook
            .Sheets(1).Cells(1).PasteSpecial _
                Paste:=xlPasteValuesAndNumberFormats
            .SaveAs "C:\TEST\MyReport-" & sItem & ".xlsx", _
                FileFormat:=xlOpenXMLWorkbook
            .Close

我只是不知道要复制某个单元格（非Pivot）要添加什么，并将其粘贴到不同的表格中，假设它符合＆gt; 0标准。我对VBA比较陌生，我正努力提高自己的技能。

添加参考屏幕截图基本上，我想迭代B3（数据透视表）并将B3和F46复制到下面的新表中如果F46> 0。：

感谢。

Answer 1

这对你有用。您需要调整下面标记的数据透视表和数据表名称。

Sub PivotStockItems()
    Dim i As Integer
    Dim sItem As String
    Dim pivotSht As Worksheet, dataSht As Worksheet

    Set pivotSht = Sheets("test") 'adjust to the name of sheet containing your pivot table
    Set dataSht = Sheets("SKUS_With_Savings") 'as per your image

    Application.ScreenUpdating = False
    With pivotSht.PivotTables("PivotTable1")
        .PivotCache.MissingItemsLimit = xlMissingItemsNone
        .PivotCache.Refresh
        With .PivotFields("Yes")
            '---hide all items except item 1
            .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("F46").Value > 0 Then
                    dataSht.Cells(getLastFilledRow(dataSht) + 1, 1).Value = sItem
                    dataSht.Cells(getLastFilledRow(dataSht), 2).Value = pivotSht.Range("F46").Value
                Else: End If

            Next i
        End With
    End With
End Sub

'gets last filled row number of the given worksheet
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

在将单个字段复制到单独的表

1 个答案: