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

The worksheets have hundreds of rows with account numbers in column A, an account description in column B and totals in column C. I want to copy the rows from all 3 worksheets into a single 4th worksheet but where duplicate account numbers are found, I want there just to be one with the totals aggregated into column C of that row and the extras deleted, like this:

工作表包含数百行,其中包含A列中的帐号,B列中的帐户描述以及C列中的总计。我想将所有3个工作表中的行复制到单个第4个工作表中,但是找到重复的帐号,我想要只有一个总计聚合到该行的C列并删除了额外内容,如下所示:

Input from sheets (all the sheets are in one .xls file):

来自工作表的输入(所有工作表都在一个.xls文件中):

Sheet 1 of workbook

工作簿的第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

Sheet 2 of workbook

工作簿第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

Sheet 3 of workbook

工作簿第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

What I would want the result to be:

                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

Notice: Some of the account numbers don't ever repeat, but some do.

注意:有些帐号不会重复,但有些帐号会重复。

3 个解决方案

#1

Here's one way.

这是一种方式。

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

Create a new module (VBA editor -> Insert -> Module) and paste the above code into it.

创建一个新模块(VBA编辑器 - >插入 - >模块)并将上面的代码粘贴到其中。
Add a reference to Microsoft Scripting Runtime (VBA editor -> Tools -> References -> Check 'Microsoft Scripting Runtime').

添加对Microsoft Scripting Runtime的引用(VBA编辑器 - >工具 - >引用 - >检查'Microsoft Scripting Runtime')。
Run it by placing the cursor within the code and pressing F5.

将光标放在代码中并按F5运行它。

Obviously the sheets will have to be named Sheet1, Sheet2, Sheet3 and Sheet4. It won't paste the column headers into Sheet4 but presumably they are static so you can just set them up yourself beforehand.

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

#2

Really what you want to do is run a macro or whatever that copies all your data from the three sheets onto a new sheet, then runs a pivot table on the result. Pivot tables handle the unique-ification of your data set and the aggregation of data for multiplicities.

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

You can use the following VB code (type Alt-F11 in Excel to get to the VBA editor, insert a new module, and paste this code into it). This code assumes your spreadsheet has three sheets named Sheet1, Sheet2, and Sheet3 that contain your data, and that the data is contiguous and starts in cell A1 on each sheet. It also presumes your spreadsheet has a sheet named "Pivot Sheet" which is where the data will all get copied into.

您可以使用以下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

This is 95% excel generated code (via Record Macro), but I changed up some stuff to make it more generic. So anyway, you can then assign that Macro to a button in the usual way, or you can assign it to a keyboard shortcut via the Tools => Macro => Macros... Options... dialog.

这是95%excel生成的代码(通过记录宏),但我更改了一些东西,使其更通用。因此,无论如何,您可以按常规方式将该宏指定给按钮,或者您可以通过Tools => Macro => Macros ... Options ...对话框将其指定给键盘快捷键。

Anyway, that will get your data aggregated onto the Pivot Sheet sheet with appropriate headings.

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

Then you can go to Data => PivotTable and PivotChart Report. Hit Next, select the data on the Pivot Sheet (including the headings!), hit Next, choose Layout.

然后你可以转到Data => PivotTable和PivotChart Report。单击下一步,选择数据透视表上的数据(包括标题!),单击下一步,选择布局。

Drag the AccountNumber field (on the right of the wizard) into the area labelled "Row". Drag the Description field to under the Account Number field in the "Row" area. Drag the Total field into the "Data" area, then double click on it in the "Data" area and choose "Sum" so that it aggregates this field. Hit OK and you should get a Pivot Table. You're probably going to want to Hide the sub-totals by right clicking on the sub-total title (i.e. "blah blah Total") and clicking Hide. That result looks basically exactly like what your desired output is.

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

If you wanted to get fancy, you could conceivably automate that last paragraph, but it's probably not worth it.

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

Hope this helps!

希望这可以帮助!

#3

I think ADO is best for this, you will find some notes here: Function for detecting duplicates in Excel sheet

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

You can use a suitable SQL string to join and group your records.

您可以使用合适的SQL字符串来加入和分组记录。

For example:

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"

#1