2

工作表有数百行，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

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

4

3 回答 3

4

这是一种方法。

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

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

  2. 添加对 Microsoft Scripting Runtime 的引用（VBA 编辑器 -> 工具 -> 参考 -> 检查“Microsoft Scripting Runtime”）。

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

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

于 2010-01-29T20:38:13.707 回答
3

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

您可以使用以下 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 Macro），但我更改了一些内容以使其更通用。因此，无论如何，您可以以通常的方式将该宏分配给按钮，或者您可以通过工具 => 宏 => 宏...选项...对话框将其分配给键盘快捷键。

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

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

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

如果您想变得花哨，可以想象将最后一段自动化，但这可能不值得。

希望这可以帮助！

于 2010-01-29T20:13:32.040 回答
2

我认为 ADO 最适合这个，你会在这里找到一些注释：用于检测 Excel 工作表中的重复项的功能

您可以使用合适的 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"
于 2010-01-29T20:32:08.827 回答