VBA-数据透视表行计数并将值复制到新工作表

已更新

我需要在数据透视表的“header”行和“grandtotal”行之间对数据透视表中的行进行行计数，然后将计数找到的值复制到汇总表中

标题行：

最后一行：

因此，我非常需要从透视表的第4行-第133行进行计数（在本例中，总行数为130），并将该值粘贴到汇总表的单元格B23

当前数据透视表布局：

我需要将计数集成到我已有的代码中，如下所示：

Option Explicit

Sub FilterPivotTable()

Dim rLastCell As Range
Dim PvtTbl As PivotTable
Dim ws1 As Worksheet, ws2 As Worksheet
Dim LastRow1 As Long
Set ws1 = ActiveWorkbook.Sheets("PivotTable")
Set ws2 = ActiveWorkbook.Sheets("Summary")

    LastRow1 = ws1.Cells(Rows.count, 1).End(xlUp).Row

    'Total - This inserts the word Total in cell B22 and pastes the total value 
'found in the grand total line of the of the pivot table, in the summary sheet 
'in line C22

    Application.ScreenUpdating = False

    ws1.PivotTables("P1").ManualUpdate = True

    ws1.PivotTables("P1").ManualUpdate = False
    Application.ScreenUpdating = True

    With ws1.PivotTables(1).TableRange1
        Set rLastCell = .Cells(.Rows.count, .Columns.count)
        Set PvtTbl = Worksheets("PivotTable").PivotTables("P1")
        rLastCell.Copy

        With ws2

        ws2.Cells(LastRow1 + 22, 3).PasteSpecial xlPasteValues
        .Range("$B$22").Value = "Total"

        End With


    End With

    'Microsoft Windows - This filters the table by any vulnerabilities that have 
'the words Microsoft Windows in their description, then it inserts the words
'Microsoft Windows in cell B2 and the grand total count of this filter
'in cell C2
    Application.ScreenUpdating = False

    ws1.PivotTables("P1").ManualUpdate = True

    ws1.PivotTables("P1").PivotFields(" Vulnerability Name").ClearAllFilters

    ws1.PivotTables("P1").PivotFields(" Vulnerability Name").PivotFilters. _
    Add Type:=xlCaptionContains, Value1:="Microsoft Windows"

    ws1.PivotTables("P1").ManualUpdate = False
    Application.ScreenUpdating = True

    With ws1.PivotTables(1).TableRange1
        Set rLastCell = .Cells(.Rows.count, .Columns.count)
        Set PvtTbl = Worksheets("PivotTable").PivotTables("P1")
        rLastCell.Copy

        With ws2

            .Cells(LastRow1 + 2, 3).PasteSpecial xlPasteValues
            .Range("$B$2").Value = "Microsoft Windows"

        End With

    End With

    ws1.PivotTables("P1").PivotFields(" Vulnerability Name").ClearAllFilters

    'Microsoft Office- This filters the table by any vulnerabilities that have 
'the words Microsoft Office in their description, then it inserts the words
'Microsoft Windows in cell B3 and the grand total count of this filter
'in cell C3
    Application.ScreenUpdating = False
    ws1.PivotTables("P1").ManualUpdate = True

    ws1.PivotTables("P1").PivotFields(" Vulnerability Name").PivotFilters. _
    Add Type:=xlCaptionContains, Value1:="Microsoft Office"

    ws1.PivotTables("P1").ManualUpdate = False
    Application.ScreenUpdating = True

    With ws1.PivotTables(1).TableRange1
        Set rLastCell = .Cells(.Rows.count, .Columns.count)
        Set PvtTbl = Worksheets("PivotTable").PivotTables("P1")
        rLastCell.Copy

        With ws2

        ws2.Cells(LastRow1 + 3, 3).PasteSpecial xlPasteValues
        .Range("$B$3").Value = "Microsoft Office"

        End With


    End With

    ws1.PivotTables("P1").PivotFields(" Vulnerability Name").ClearAllFilters

  End Sub

到目前为止，我有以下代码进行计数：

lRowCount = ActiveSheet.PivotTables("P1").TableRange1.Rows.Count

但不确定在何处集成此值以及如何复制lRowCount值

---

此行计数需要在每个代码块中进行。因此，当对Microsoft Office的漏洞名称进行筛选时，我还需要对筛选后的数据进行行计数。

我认为这应该可以让您继续

Sub PivotTable(ByVal ParamValue As String)
  Dim rLastCell As Range
  Dim PvtTbl As PivotTable
  Dim ws1 As Worksheet, ws2 As Worksheet
  Dim LastRow1 As Long
  'Your lRowCount variable
  Dim lRowCount As Long

  Set ws1 = ActiveWorkbook.Sheets("PivotTable")
  Set ws2 = ActiveWorkbook.Sheets("Summary")
  LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
  Application.ScreenUpdating = False

  With ws1.PivotTables(1)
    .ManualUpdate = False
    Set rLastCell = .TableRange1.Cells(.Rows.Count, .Columns.Count)
    Set PvtTbl = Worksheets("PivotTable").PivotTables("P1") '???
    '
    'Get the row count from your pivot table.
    lRowCount = .Rows.Count
    With ws2
      'Performance enhancement, as there is no need for copy/past.
      .Cells(LastRow1 + 22, 3) = rLastCell.Value
      .Range("$B$22").Value = "Total"
      '
      'Arbitrary place to copy to. Adjust to your need.
      .Cells(LastRow1 + 23, 3) = lRowCount
      .Range("$B$23").Value = "Rowcount P1"
    End With
  End With
  With ws1.PivotTables("P1")
    .ManualUpdate = True
    .PivotTables("P1").PivotFields(ParamValue).ClearAllFilters
    .PivotTables("P1").PivotFields(ParamValue).PivotFilters _
       .Add Type:=xlCaptionContains, Value1:=ParamValue
    .PivotTables("P1").ManualUpdate = False
  End With
  With ws1.PivotTables(1).TableRange1
    Set rLastCell = .Cells(.Rows.Count, .Columns.Count)
    Set PvtTbl = Worksheets("PivotTable").PivotTables("P1") '???
    With ws2
      .Cells(LastRow1 + 2, 3).Value = rLastCell.Value
      .Range("$B$2").Value = "Microsoft Windows"
    End With
  End With
  Application.ScreenUpdating = True
End Sub
'
'Usage:
'  call PivotTable("Param1")
'  call PivotTable("Param2")
'  etc.

---

数据透视表数据区域行的简单计数是

DataBodyRange.Rows.Count

例如：

Worksheets("PivotTable").ListObjects(1).DataBodyRange.Rows.count

更详细的：

Option Explicit

Sub test()
    Dim rowCount As Long
    rowCount = Worksheets("PivotTable").ListObjects(1).DataBodyRange.Rows.count
    Worksheets("Summary").Range("B23") = rowCount
End Sub

在您的情况下，您可以简写为：

PvtTbl.DataBodyRange.Rows.count 

---

我很困惑。你是在更改数据透视字段，而不是过滤给定字段中可见的内容，不是吗？该死，现在我也很困惑。。其目的是有效地应用了两个过滤器——1）对第一个参数进行过滤，然后2）对第一个参数的“过滤”结果进行过滤。我用一个例子更新了代码这些是页面字段吗？你能展示你的数据透视表布局吗？如果你尝试执行这些操作，你的宏记录器记录了什么？你能发布一个透视表的屏幕截图和数据吗？如果可能的话，只是为了提供一个想法？我已经在@SJR显著更新了原始帖子-我希望现在它更有意义了？很遗憾，我无法发布实际数据的截图，但我希望我提供的内容足以让您帮助我。谢谢您的回复@C.van Dorsten。我复制了您的代码并尝试对其进行测试，但宏未显示在可用宏的列表中。然而，我已经将这篇文章编辑成一个特定的问题，上面已经回答了这个问题。再次感谢：）当然不会，因为它需要一个参数。你应该把它改名或者别的什么。我只是用你的代码给你一个你可以使用的例子。那为什么要投反对票呢？我不是投反对票的人。请不要以为我在你的帮助下没有得到想要的结果，所以我立即投票否决了你。好的。对不起我的话。那天工作很糟糕，但不该拿你出气。再次抱歉。