合並兩張紙上的數據並在另一張紙上生成數據透視表

Question

我有一個名為“數據和丟失”的工作表。 兩個工作表都包含相同數量的列。 數據表的數據從第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。 如果將兩個源范圍都設置為表格並記下它們的名稱，例如Table3和Table4，則

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

請嘗試一下...

在實施此代碼之前要了解的重要事項：

1. 該代碼假定您在工作簿中有三張工作表，分別是“數據”，“缺少”和“開發”。
2. 在數據表上，將數據轉換為Excel表並將其命名為“數據”。
3. 同樣，在Missing Sheet上，將數據轉換為Excel Table並將其命名為“ 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