Question

我在电子表格中使用切片器设置了数据透视表。因此，根据选择的内容，列A可以在显示的1行数据（不包括标题和总计）到50行之间变化。

当您双击一行时，数据将在新表中打开。我试图获取一个按钮以自动打开我的透视结果中的所有详细信息。因此，如果有1个结果，请按按钮，然后将打开1个新表。如果有9个结果，则将打开9个新工作表以显示基础的“向下钻取”数据。

编辑：我找到了一些代码，它几乎可以正常工作，但是它打开了新的工作表（这是正确的），但是每个工作表都包含来自显示内容的所有信息。我希望它细分每个下钻。您知道如何修改它以使其适合我的需求吗？

  Sub drill()
   Dim sel As Variant, aRng As Range
   Application.ScreenUpdating = False


 Sheets("sheet1").Select

   Range("A5").Select
   Set aRng = Range("A5")
   While aRng.Value <> "Grand Total"
     With Sheets("sheet1").PivotTables(1)
       sel = .GetPivotData.Address
     End With
     Range(sel).ShowDetail = True

     Range("a1").Select

     Sheets("sheet1").Activate
     Set aRng = aRng.Offset(1, 0)
   Wend

   Application.ScreenUpdating = True
 End Sub

Answer 1

我无法使您发布的代码正常运行（尤其是.GetPivotData.Address部分）。但是，以下代码对我有用。

Sub drill()
   Dim sel As Variant, topRow As Long, firstCol As Long, sht As Worksheet
   Application.ScreenUpdating = False

    Set sht = Sheets("sheet1")

    With sht.PivotTables(1)
        topRow = .DataBodyRange.Row 'This is the minimum row number of the pivot body (excluding titles)
        firstCol = .DataBodyRange.Column 'This is the minimum col number of the pivot body (excluding row labels)
        For Each sel In .RowRange.Resize(, 1) 'Selects only the first column cells of the row labels
            If sel.Row >= topRow And sel.Value <> "Grand Total" Then sht.Cells(sel.Row, firstCol).ShowDetail = True
        Next sel
    End With

   Application.ScreenUpdating = True
 End Sub

VBA按钮可深入到PIvot表

1 个答案: