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

Question

更新

我需要对表的 "header" 行和表的 "grand total" 行之间的数据透视表中的行进行行计数然后将计数找到的值复制到汇总表中。

标题行：

最后一行：

所以我非常需要从数据透视表的 第 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 值。

这个行数需要在每个With代码块中完成。因此，当对 Microsoft Office 的漏洞名称进行过滤时，我还需要对过滤后的数据进行行计数。

Answer 1

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

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 

Answer 2

我认为这应该让你继续前进。

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.