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

时间:2018-04-06 11:34:06

标签: excel vba excel-vba

已更新

我需要在表格的"标题" 行和"总计&#之间对数据透视表中的行进行行计数34; 表的行,然后将计数找到的值复制到摘要表。

标题行:

FirstRow

最后一行:

LastRow

因此我非常需要从数据透视表的第4行 - 第133行(在这种情况下,总行数为130)进行计数,并将该值粘贴到 摘要表上的单元格B23

当前数据透视表布局:

CurrentPivotTableLayout

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

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的漏洞名称进行过滤时,我还需要对过滤后的数据执行行计数。

2 个答案:

答案 0 :(得分: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 

答案 1 :(得分:-1)

我认为这应该让你去。

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.