Excel宏：如何复制3个工作表中的所有行并合并第一列中唯一的行？

工作表有数百行，其中A列为帐号，B列为帐号说明，C列为总计。我想将所有3个工作表中的行复制到一个单独的第4个工作表中，但如果发现重复的账号，我只希望有一个，总计汇总到该行的C列，并删除额外的内容，如下所示：

来自工作表的输入（所有工作表都在一个.xls文件中）：

工作簿的工作表1

                A                     B                       C
1            abc-123            Project Costs             1,548.33
2            abc-321           Housing Expenses                250
3            abc-567           Helicopter Rides          11,386.91

                A                     B                       C
1            abc-123            Project Costs             1,260.95
2            abc-321           Housing Expenses                125
3            abc-567           Helicopter Rides          59,605.48

                A                     B                       C
1            abc-123            Project Costs             1,785.48
2            abc-321           Housing Expenses                354
3            def-345            Elephant Treats         814,575.31

工作簿的第2页

                A                     B                       C
1            abc-123            Project Costs             1,548.33
2            abc-321           Housing Expenses                250
3            abc-567           Helicopter Rides          11,386.91

                A                     B                       C
1            abc-123            Project Costs             1,260.95
2            abc-321           Housing Expenses                125
3            abc-567           Helicopter Rides          59,605.48

                A                     B                       C
1            abc-123            Project Costs             1,785.48
2            abc-321           Housing Expenses                354
3            def-345            Elephant Treats         814,575.31

工作表3

                A                     B                       C
1            abc-123            Project Costs             1,548.33
2            abc-321           Housing Expenses                250
3            abc-567           Helicopter Rides          11,386.91

                A                     B                       C
1            abc-123            Project Costs             1,260.95
2            abc-321           Housing Expenses                125
3            abc-567           Helicopter Rides          59,605.48

                A                     B                       C
1            abc-123            Project Costs             1,785.48
2            abc-321           Housing Expenses                354
3            def-345            Elephant Treats         814,575.31

我希望结果是：

---

注意：有些帐号永远不会重复，但有些会重复。

您真正想做的是运行一个宏或任何东西，将三张工作表中的所有数据复制到一张新工作表上，然后对结果运行透视表。数据透视表处理数据集的唯一化和多重性数据的聚合

---

您可以使用以下VB代码（在Excel中键入Alt-F11以进入VBA编辑器，插入新模块，然后将此代码粘贴到其中）。此代码假定电子表格有三张表，分别名为Sheet1、Sheet2和Sheet3，其中包含您的数据，并且数据是连续的，从每张表的单元格A1开始。它还假定您的电子表格有一个名为“透视表”的表，数据将全部复制到该表中

Sub CopyDataToPivotSheet()

  Sheets("Pivot Sheet").Select
  Range("A1:IV65536").Select
  Selection.Clear

  Sheets("Sheet1").Select
  Range("A1").Select
  Range(Selection, Selection.End(xlToRight)).Select
  Range(Selection, Selection.End(xlDown)).Select
  Selection.Copy
  Sheets("Pivot Sheet").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False

  Sheets("Sheet2").Select
  Range("A1").Select
  Range(Selection, Selection.End(xlDown)).Select
  Range(Selection, Selection.End(xlToRight)).Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("Pivot Sheet").Select
  Range("A1").Select
  Selection.End(xlDown).Offset(1, 0).Range("A1").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False

  Sheets("Sheet3").Select
  Range("A1").Select
  Range(Selection, Selection.End(xlToRight)).Select
  Range(Selection, Selection.End(xlDown)).Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("Pivot Sheet").Select
  Selection.End(xlDown).Select
  Range("A1").Select
  Selection.End(xlDown).Offset(1, 0).Range("A1").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False

  Rows("1:1").Select
  Application.CutCopyMode = False
  Selection.Insert Shift:=xlDown
  Range("A1").Select
  ActiveCell.FormulaR1C1 = "AccountNum"
  Range("B1").Select
  ActiveCell.FormulaR1C1 = "Description"
  Range("C1").Select
  ActiveCell.FormulaR1C1 = "Total"

End Sub

这是95%的excel生成的代码（通过Record宏），但我修改了一些内容使其更通用。因此，无论如何，您可以用通常的方式将该宏分配给按钮，也可以通过Tools=>Macro=>Macros将其分配给键盘快捷键。。。选项。。。对话

无论如何，这将使您的数据聚合到具有适当标题的透视表上

然后可以转到Data=>PivotTable和PivottChart Report。点击下一步，选择数据透视表上的数据（包括标题！），点击下一步，选择布局

将AccountNumber字段（向导右侧）拖到标有“行”的区域中。将“说明”字段拖到“行”区域的“帐号”字段下。将Total字段拖到“数据”区域，然后双击“数据”区域中的Total字段并选择“Sum”以聚合此字段。点击OK，你会得到一个透视表。您可能想通过右键单击小计标题（即“等等”）并单击隐藏来隐藏小计。该结果基本上与您期望的输出完全相同

如果你想变得花哨，你可以想象自动完成最后一段，但这可能不值得

---

希望这有帮助

我认为ADO是最好的选择，您可以在这里找到一些注意事项：

您可以使用合适的SQL字符串来连接和分组记录

例如：

strSQL = "SELECT F1, F2, Sum(F3) FROM (" _
       & "SELECT F1,F2,F3 FROM [Sheet1$] " _
       & "UNION ALL " _
       & "SELECT F1,F2,F3 FROM [Sheet2$] " _
       & "UNION ALL " _
       & "SELECT F1,F2,F3 FROM [Sheet3$] ) " _
       & "GROUP BY F1, F2"

这里有一条路

Option Explicit

Sub Test()
    Dim sheetNames: sheetNames = Array("Sheet1", "Sheet2", "Sheet3")
    Dim target As Worksheet: Set target = Worksheets("Sheet4")
    Dim accounts As New Dictionary
    Dim balances As New Dictionary
    Dim source As Range
    Dim row As Range
    Dim id As String
    Dim account As String
    Dim balance As Double
    Dim sheetName: For Each sheetName In sheetNames
        Set source = Worksheets(sheetName).Range("A1").CurrentRegion
        Set source = source.Offset(1, 0).Resize(source.Rows.Count - 1, source.Columns.Count)
        For Each row In source.Rows
            id = row.Cells(1).Value
            account = row.Cells(2).Value
            balance = row.Cells(3).Value
            accounts(id) = account
            If balances.Exists(id) Then
                balances(id) = balances(id) + balance
            Else
                balances(id) = balance
            End If
        Next row
    Next sheetName

    Call target.Range("A2:A65536").EntireRow.Delete

    Dim rowIndex As Long: rowIndex = 1
    Dim key
    For Each key In accounts.Keys
        rowIndex = rowIndex + 1
        target.Cells(rowIndex, 1).Value = key
        target.Cells(rowIndex, 2).Value = accounts(key)
        target.Cells(rowIndex, 3).Value = balances(key)
    Next key
End Sub

创建一个新模块（VBA编辑器->插入->模块）并将上面的代码粘贴到其中

添加对Microsoft脚本运行时的引用（VBA编辑器->工具->引用->选中“Microsoft脚本运行时”）

通过将光标放在代码中并按F5来运行它

---

显然，图纸必须命名为Sheet1、Sheet2、Sheet3和Sheet4。它不会将列标题粘贴到Sheet4中，但它们可能是静态的，因此您可以自己预先设置它们。

哦，太好了。是的，这就是我的意思。我原以为它叫VBScript，但有人把我的标题改成了VBA。是这样吗？我该怎么做你提到的所有事情呢？另外，VBA代码只是上面提到的“有用”，它不是必需的，因为你也可以随时手动将数据复制到透视表中。成功了！！！！！谢谢，但它输出了一些：9.09495E-15。我没有提到“总计”部分中的一些输入是0，但它们在excel中显示为破折号，如果我双击该字段，我可以看到0。当进入新文件时，所有的字段都变成了E-24的东西。哦，我只是把Double改成了Currency，它工作了。非常感谢你，伙计。您的代码太棒了（基于代码的简单性，我认为您会喜欢Python）。非常感谢您的支持。我确实是Python的粉丝。自从我最近专攻.NET以来，我一直在玩IronPython。IronPython工具目前有点有限，但我希望看到它有所改进。如果有时间的话，我也希望在某个阶段使用纯Python