vba 如何比较（不同）工作表上的两个（枢轴）表数据？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/22531575/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How to compare two (pivot) tables data on (different) worksheets?
提问by Christian St.
There are 2 worksheets in 1 excel file with the following identical column structure:
1 个 excel 文件中有 2 个工作表，具有以下相同的列结构：
BuildIndex | Phase | Module | Duration
The column BuildIndexis used as primary key.
该列BuildIndex用作主键。
Assume the following example data:
假设以下示例数据：
Worksheet 1:
工作表 1：
1 | Phase 1 | Module 1 | 5
1 | Phase 2 | Module 1 | 3
1 | Phase 3 | Module 1 | 10
1 | Phase 1 | Module 2 | 6
1 | Phase 2 | Module 2 | 2
1 | Phase 3 | Module 2 | 5
Worksheet 2:
工作表 2：
2 | Phase 1 | Module 1 | 3
2 | Phase 2 | Module 1 | 7
2 | Phase 3 | Module 1 | 9
2 | Phase 1 | Module 2 | 2
2 | Phase 2 | Module 2 | 10
2 | Phase 3 | Module 2 | 4
For now I create different pivot tables and diagrams and analyze the differences "by hand" to make decisions like
现在我创建不同的数据透视表和图表并“手动”分析差异以做出如下决定
- for build index 1the module 2is build X seconds faster than in build index 2
- for build index 2the phase 3(sum of all modules) is build Y seconds faster than in build index 1
- 对于构建索引 1，模块 2的构建速度比构建索引 2快 X 秒
- 对于构建索引 2，阶段 3（所有模块的总和）的构建速度比构建索引 1快 Y 秒
That's what I want to do:
这就是我想要做的：
Because there are many phases and the count of modules is increasing continuously, the above procedure takes too much time and I think there's an automatic way to perform analyzes like these.
因为有很多阶段并且模块的数量不断增加，所以上述过程需要太多时间，我认为有一种自动方法可以执行这样的分析。
So, do you have any idea if there's a way to realize my intention? Feel free to provide hints for excel formulas or pivot tables or vba or or or :-)
那么，你知道有没有办法实现我的意图吗？随意提供有关 Excel 公式或数据透视表或 vba 或或或的提示:-)
采纳答案by Christian St.
I solved it using VBA. Never worked before with it, so my code could be improved ;-)
我用VBA解决了它。以前从未使用过它，所以我的代码可以改进;-)
Call AllInOnefor phases (any variable used is declared as String):
调用AllInOne阶段（使用的任何变量都声明为String）：
Option Explicit
Sub ExtractUniquePhasesAndModules()
'--------------------------------------
'| Perform calculations for TEST DATA |
'--------------------------------------
srcSheet = "CompareData"
destSheet = "CompareResults"
destPkColumn = "A"
destColumn = "B"
calculateColumn = "C"
'Phases 1
srcPkCell = "A2"
srcColumn = "B"
sumValuesColumn = "D"
AllInOne srcSheet, srcColumn, destSheet, destColumn, calculateColumn, sumValuesColumn, srcPkCell, destPkColumn
'Phases 2
srcPkCell = "F2"
srcColumn = "G"
sumValuesColumn = "I"
AllInOne srcSheet, srcColumn, destSheet, destColumn, calculateColumn, sumValuesColumn, srcPkCell, destPkColumn
End Sub
And this is the problem solving function:
这是解决问题的功能：
Private Sub AllInOne(srcSheetName As String, srcColumnName As String, destSheetName As String, _
destColumnName As String, calculateColumnName As String, sumValuesColumnName As String, _
srcPkCellName As String, destPkColumnName As String)
Dim srcSheet As Worksheet
Dim destSheet As Worksheet
Dim srcColumn As Range
Dim destColumn As Range
Dim srcPkCell As Range
Dim destPkColumn As Range
Dim sumValuesColumn As Range
Dim wsf As WorksheetFunction
Set srcSheet = Worksheets(srcSheetName)
Set srcColumn = srcSheet.Range(srcColumnName + ":" + srcColumnName)
Set destSheet = Worksheets(destSheetName)
Set destColumn = destSheet.Range(destColumnName + ":" + destColumnName)
Set srcPkCell = srcSheet.Range(srcPkCellName)
Set destPkColumn = destSheet.Range(destPkColumnName + ":" + destPkColumnName)
Set sumValuesColumn = srcSheet.Range(sumValuesColumnName + ":" + sumValuesColumnName)
Set wsf = WorksheetFunction
'-----------------------
'Copy all unique values|
'-----------------------
destSheet.Select
Dim ctr As Range
'find the first empty cell
For Each ctr In destColumn.Cells
If ctr.Value = "0" Then
'do nothing
ElseIf ctr.Value = Empty Then
Exit For
End If
Next
'start copying
srcColumn.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ctr, Unique:=True
'set destination range to only the new cells
Set destColumn = destSheet.Range(ctr.Address + ":" + destColumnName & destColumn.Count)
Dim cell As Range
Dim calcCell As Range
Dim destPkCell As Range
For Each cell In destColumn.Cells
'end of list reached?
If cell.Value = Empty Then
Exit For
End If
'Fill in primary key
Set destPkCell = destSheet.Range(destPkColumnName & cell.Row)
destPkCell.Value = srcPkCell.Value
'Perform the sum-calculation and show the result
Set calcCell = destSheet.Range(calculateColumnName & cell.Row)
calcCell.Value = wsf.SumProduct(wsf.SumIf(srcColumn, "=" & cell.Value, sumValuesColumn))
Next
End Sub
First it iterates over the destination column to find the first empty cell. This cell is then used as CopyToRangeargument in the AdvancedFilterfunction.
首先，它遍历目标列以找到第一个空单元格。然后将该单元格用作CopyToRange函数中的AdvancedFilter参数。
Then it inserts the primary key (BuildIndexin my case) and the result of SumProductfor every row.
然后它插入主键（BuildIndex在我的例子中）和SumProduct每一行的结果。
The result for phases using the questions data is this:
使用问题数据的阶段结果如下：
1 | Phase | 0
1 | Phase 1 | 11
1 | Phase 2 | 5
1 | Phase 3 | 15
2 | Phase | 0
2 | Phase 1 | 5
2 | Phase 2 | 17
2 | Phase 3 | 13
Now I'm able to create diagrams just like I want :-)
现在我可以像我想要的那样创建图表:-)
