Question

工作表包含数百行，帐户编号在 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

工作簿的 2

                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

工作簿的 3 表

                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

我希望得到的结果是：

                A                     B                       C
1            abc-123            Project Costs             4,642.28
2            abc-321           Housing Expenses                729
3            abc-567           Helicopter Rides          70,992.39
4            def-345            Elephant Treats         814,575.31

注意：有些帐号不会重复，但有些会这样做。

Answer 1

这是一种方式。

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编辑器 - ＆gt;插入 - ＆gt;模块）并将上述代码粘贴到其中。
添加对Microsoft Scripting Runtime的引用（VBA编辑器 - ＆gt;工具 - ＆gt;引用 - ＆gt;检查'Microsoft脚本运行时'）。
将光标放在代码中并按F5。

显然，工作表必须命名为Sheet1，Sheet2，Sheet3和Sheet4。它不会将列标题粘贴到Sheet4中，但可能它们是静态的，所以您可以事先自己设置它们。

Answer 2

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

您可以使用以下VB代码（在Excel中键入Alt-F11以访问VBA编辑器，插入新模块，并将此代码粘贴到其中）。此代码假定您的电子表格包含三个名为Sheet1，Sheet2和Sheet3的工作表，其中包含您的数据，并且数据是连续的，并在每个工作表的单元格A1中开始。它还假设您的电子表格有一个名为“Pivot Sheet”的工作表，这是将数据全部复制到的位置。

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生成的代码（通过记录宏），但我改变了一些东西，使其更通用。因此，无论如何，您可以按常规方式将该宏指定给按钮，或者您可以通过Tools =＆gt;将其指定给键盘快捷键。宏=＆gt;宏...选项...对话框。

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

然后你可以去Data =＆gt;数据透视表和数据透视图报告。点击Next，选择数据透视表上的数据（包括标题！），点击Next，选择Layout。

将AccountNumber字段（位于向导右侧）拖到标有“Row”的区域。将“描述”字段拖到“行”区域中的“帐户编号”字段下。将Total字段拖动到“Data”区域，然后在“Data”区域中双击它并选择“Sum”以便它聚合该字段。点击确定你应该得到一个数据透视表。您可能希望通过右键单击小标题（即“blah blah Total”）并单击“隐藏”来隐藏小计。该结果基本上与您期望的输出完全相同。

如果你想获得幻想，你可以想象自动化最后一段，但它可能不值得。

希望这有帮助！

Answer 3

我认为ADO最适合这个，你会在这里找到一些注意事项：Function for detecting duplicates in Excel sheet

您可以使用合适的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"

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

我希望得到的结果是：

3 个答案: