Question

我有一张名为Data and Missing的表格。两个工作表包含相同数量的列。数据表的数据从第5行开始，缺少的工作表的数据从第2行开始。

我想在我的工作表“Dev”中生成一个数据透视表，其中我将有一个显示数据的数据透视表。

我在下面提供了一个示例图片。

我为一张工作表运行以下代码并生成数据透视表。有人可以建议，我如何能够满足这一要求。

Sub pivotAPQP()
Dim sp1 As Worksheet
Dim pcache As PivotCache
Dim ptable As PivotTable
Dim ct As Integer
Set sp1 = Sheets("Dev")
'Se the pivot cache for pivot table
Set pcache = ActiveWorkbook.PivotCaches.Create(xlDatabase, "'Data'!R4C1:R1048576C16")
'set the pivot tbale in sheet
Set ptable = pcache.CreatePivotTable(sp1.Range("A3"), TableName:="PivotTable1")
'Decalre the parameter needed to be counted
ptable.AddDataField ptable.PivotFields("COlour"), "Count of colour", xlCount
'Declare the parameter for the row field adn arrange the values in descending order
With ptable
With .PivotFields("Loc")
.Orientation = xlRowField
.Position = 1
.PivotItems("(blank)").Visible = False
.AutoSort xlDescending, "Count of colour"
End With
'Declare the parameters for column field and alighn the values to center
With .PivotFields("Colour")
.Orientation = xlColumnField
.Position = 1
.PivotItems("(blank)").Visible = False
ptable.TableRange2.Offset(0, 1).HorizontalAlignment = xlCenter
End With
End With
End Sub

编辑：尝试为我的要求实施专家提供的代码

Sub pivotAPQP1()
Dim wsData As Worksheet, wsMissing As Worksheet, wsPivot As Worksheet
Dim tbl1 As ListObject, tbl2 As ListObject
Dim pc As PivotCache, pt As PivotTable, pf As PivotField

Application.ScreenUpdating = False

Set wsData = Sheets("Data")
Set wsMissing = Sheets("Missing")
Set wsPivot = Sheets("Dev")
wsPivot.Cells.Clear

Set tbl1 = wsData.ListObjects("Table10")
Set tbl2 = wsMissing.ListObjects("Table19")

Set pc = ThisWorkbook.PivotCaches.Create( _
        SourceType:=xlConsolidation, _
        SourceData:=Array( _
        Array("'" & wsData.Name & "'!" & tbl1.Range.Address(ReferenceStyle:=xlR1C1), wsData.Name), _
        Array("'" & wsMissing.Name & "'!" & tbl2.Range.Address(ReferenceStyle:=xlR1C1), wsMissing.Name)))

Set pt = pc.CreatePivotTable( _
            TableDestination:=wsPivot.Range("A3"), _
            TableName:="PivotTable1")
pt.AddDataField pt.PivotFields("Colour"), "Count of colour", xlCount

With pt
With .PivotFields("Loc")
.Orientation = xlRowField
.Position = 1
.PivotItems("(blank)").Visible = False
.AutoSort xlDescending, "Count of colour"
End With
'Declare the parameters for column field and alighn the values to center
With .PivotFields("Colour")
.Orientation = xlColumnField
.Position = 1
.PivotItems("(blank)").Visible = False
pt.TableRange2.Offset(0, 1).HorizontalAlignment = xlCenter
End With
End With
End Sub

Answer 1

您不需要VBA。如果您将两个源范围设置为表并记下其名称，例如表3和表4然后

1）将源范围设置为表

2）按Alt，D，P打开数据透视表向导，然后选择多个合并范围并创建可转动报告

3）选择为我创建一个页面：

4）如图所示添加你的表名

5）根据需要排列字段

6）取消选中使用下拉列表显示的空白列

您可以为某些项目提供比此处所示更有意义的名称。

使用VBA，您可以在执行上述步骤的同时录制宏，以了解代码步骤和语法。

一个例子，将根据您的环境量身定制如下：

   Sub CreatePivotMultiRange1()
'
' CreatePivotMultiRange1 Macro
'

'
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlConsolidation, SourceData:= _
        Array(Array("Table3[#All]", "Item1"), Array("Table4[#All]", "Item2")), Version:= _
        6).CreatePivotTable TableDestination:="[Book1]Sheet7!R15C8", TableName:= _
        "PivotTable7", DefaultVersion:=6
    ActiveSheet.PivotTables("PivotTable7").DataPivotField.PivotItems( _
        "Count of Value").Position = 1
    With ActiveSheet.PivotTables("PivotTable7").PivotFields("Value")
        .Orientation = xlColumnField
        .Position = 2
    End With
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("L18").Select
    With ActiveSheet.PivotTables("PivotTable7").PivotFields("Row")
        .PivotItems("(blank)").Visible = False
    End With
    Range("K16").Select
    ActiveSheet.PivotTables("PivotTable7").PivotFields("Column").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable7").PivotSelect "'Column Grand Total'", _
        xlDataAndLabel + xlFirstRow, True
    ActiveSheet.PivotTables("PivotTable7").ColumnGrand = False
End Sub

你的台词：

Set pcache = ActiveWorkbook.PivotCaches.Create(xlDatabase, "'Data'!R4C1:R1048576C16")
'set the pivot tbale in sheet
Set ptable = pcache.CreatePivotTable(sp1.Range("A3"), TableName:="PivotTable1")

变成类似的东西：

 ActiveWorkbook.PivotCaches.Create(SourceType:=xlConsolidation, SourceData:= _
    Array(Array("Table3[#All]", "Item1"), Array("Table4[#All]", "Item2")), Version:= _
    6).CreatePivotTable TableDestination:=sp1.Range("A3"), TableName:= _
    "PivotTable1", DefaultVersion:=6

Set pt = sp1.PivotTables("PivotTable1")

并在顶部添加以下行以及声明：

 Dim pt As PivotTable

您可能需要进行一些代码更新，因为您已经完成了ptable字段添加。

宏记录的其余代码为您提供布局。

Answer 2

请试一试......

在实施此代码之前需要了解的重要事项：

代码假定您在工作簿中有三张名为“Data”，“Missing”和“Dev”的表。
在数据表上，将您的数据转换为Excel表格并将其命名为“数据”。
同样，在Missing Sheet上，将您的数据转换为Excel表并将其命名为“Missing”。

这就是将此代码实现到工作簿所需的全部内容。代码将以您想要的格式在开发表上创建数据透视表。

<强>代码：

Sub CreatePivotTable()
Dim wsData As Worksheet, wsMissing As Worksheet, wsPivot As Worksheet
Dim tbl1 As ListObject, tbl2 As ListObject
Dim pc As PivotCache, pt As PivotTable, pf As PivotField

Application.ScreenUpdating = False

Set wsData = Sheets("Data")
Set wsMissing = Sheets("Missing")
Set wsPivot = Sheets("Dev")
wsPivot.Cells.Clear

Set tbl1 = wsData.ListObjects("Data")
Set tbl2 = wsMissing.ListObjects("Missing")

Set pc = ThisWorkbook.PivotCaches.Create( _
        SourceType:=xlConsolidation, _
        SourceData:=Array( _
        Array("'" & wsData.Name & "'!" & tbl1.Range.Address(ReferenceStyle:=xlR1C1), wsData.Name), _
        Array("'" & wsMissing.Name & "'!" & tbl2.Range.Address(ReferenceStyle:=xlR1C1), wsMissing.Name)))

Set pt = pc.CreatePivotTable( _
            TableDestination:=wsPivot.Range("A3"), _
            TableName:="PivotTable1")

Set pf = pt.PivotFields("Value")
pf.Orientation = xlColumnField
Set pf = pt.PivotFields("Column")
pf.Orientation = xlHidden
pt.ColumnGrand = False
Application.ScreenUpdating = True
End Sub

合并两张纸的数据并在另一张纸中生成数据透视表

2 个答案: