excel - VBA 按钮可深入到数据透视表

Question

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

当您双击 1 行时，数据将在新工作表中打开。
我正在尝试获取一个按钮来自动打开我的数据透视结果中的所有详细信息。因此，如果有 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