Question

首先，我对VBA知之甚少，并没有尝试为我想做的事情编写代码，因为我甚至不知道从哪里开始。

我目前有两张桌子。表1包含48000行数据和两列，每个ID的唯一标识符和现金金额。表2包含50000行数据和两列，每个ID的唯一标识符和现金金额。 ID号对于它们自己的表是唯一的，因此在另一个表中经常有重复的ID。这样做的目的是将两个表格按ID号组合，并显示每个ID号码的总现金金额。

我的第一次尝试涉及使用SUMIF函数从两个表中获取总数。虽然这适用于第一个ID，但当我尝试将公式复制到其他单元格时，我的笔记本电脑完全崩溃，迫使重启。

我的第二次尝试涉及使用数据透视表向导来组合两个范围。但是，我发现数据透视表无法处理这么多独特的值。（基于出现的弹出窗口）。

我的第三次尝试有效，但我发现它很长，我希望有更好的方法。我将表格分成两个大约20,000行的范围（所以现在有4个表格）。然后我使用数据透视表向导一次合并这两个。首先是表1和表3，然后是表2和表4。然后我不得不再次拆分结果列表，因为数据透视表无法处理它并重复此过程。这种方法的问题是我觉得由于所有的分裂，有可能错过或重复值。

在所有这三次尝试中，我的计算机反复出现问题并需要重新启动。

我不在乎VBA解决方案是否需要一段时间才能运行，只要它有效。

我已经尝试过查看其他示例，但有些我无法弄清楚如何将它们应用到我的情况中，而其他人似乎并没有使用足够大的文件来体验我的一些问题面对。

谢谢，如果您需要澄清，请告诉我。

Answer 1

我建议通过ADO连接连接到工作表，并使用SQL语句连接这两个表。

添加对 Microsoft ActiveX数据对象库的引用（工具 - ＆gt;引用... ） - 使用通常为6.1的最新版本。

将模块插入VBA项目并粘贴以下代码：

Sub JoinTables()

Dim connectionString As String
connectionString = _
    "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=""" & ActiveWorkbook.FullName & """;" & _
    "Extended Properties=""Excel 12.0;HDR=Yes"""

'The SQL statement that shapes the resulting data
Dim sql As String
sql = _
    "SELECT t1.ID, t1.Value + IIF(t2.Value IS NULL, 0, t2.Value) AS FinalSum " & _
    "FROM [Sheet1$] AS t1 " & _
    "LEFT JOIN [Sheet2$] AS t2 ON t1.ID = t2.ID " & _
    "UNION SELECT t2.ID, t2.Value " & _
    "FROM [Sheet2$] AS t2 " & _
    "LEFT JOIN [Sheet1$] AS t1 ON t2.ID = t1.ID " & _
    "WHERE t1.ID IS NULL"

Dim rs As New ADODB.Recordset
'All the fun happens here
rs.Open sql, connectionString

'Paste the resulting records into the third sheet of the active workbook
ActiveWorkbook.Sheets(3).Range("A2").CopyFromRecordset rs

Set rs = Nothing

End Sub

注意：

目前，记录集正在从当前（Excel）工作簿中读取数据。如果数据来自数据库，modify the connection string直接连接数据库并对数据库发出SQL语句可能更简单，更有效。
该代码假定每个工作表的第一行包含列标签，例如ID和Value。如果不是这种情况，请在HDR=No的第三行（而不是connectionString）中指定HDR=Yes，字段将是从F1开始的自动分配名称，{ {1}}等等。
结果将粘贴到活动工作簿的第三个工作表中。这可能适合也可能不适合。
您没有指定数据的排序方式，但通过在SQL语句中添加F2子句，这很简单。

SQL语句的说明

我们正在比较两张桌子。对于给定的ID，可能有三种可能性：
1. ID出现在两个表中，
2.它只出现在第一个表格或中 3.它只出现在第二个表格中。

我们还假设每个表中的ID都是唯一的。

声明的前半部分（最多ORDER BY）处理1和2.

UNION

可以描述如下：

从第一个表格中的记录开始 - SELECT t1.ID, t1.Value + IIF(t2.Value IS NULL, 0, t2.Value) AS FinalSum FROM [Sheet1$] AS t1 LEFT JOIN [Sheet2$] AS t2 ON t1.ID = t2.ID

根据ID - FROM [Sheet1$] AS t1
将第二个表中的每个记录与第一个表中的相应记录相匹配
包含第一个表中的所有记录，并且只匹配第二个表中的匹配记录 - LEFT JOIN [Sheet2$] AS t2 ON t1.ID = t2.ID中的LEFT

返回两列：第一个表中的ID，以及第一个和第二个表中值的组合 - LEFT JOIN

如果第二个表中没有匹配的记录，则该值将为NULL（与零不同）。尝试将数字添加到NULL将返回NULL，这不是我们想要的。所以我们必须写这个公式 - SELECT ...：



如果第二个表中的值为null，则添加0



否则添加第二个表

中的值

语句的后半部分处理仅出现在第二个表中的ID：

t1.Value + IIF(t2.Value IS NULL, 0, t2.Value)

在第一组结果的基础上添加第二组结果 - UNION SELECT t2.ID, t2.Value FROM [Sheet2$] AS t2 LEFT JOIN [Sheet1$] AS t1 ON t2.ID = t1.ID WHERE t1.ID IS NULL

从第二个表 - UNION
中的记录开始
将第一个表中的记录与第二个表中的记录进行匹配（请注意，这与查询的前半部分相反） - {{1} }

我们只希望第一个表中没有ID的记录 - FROM [Sheet2$] AS t2

Answer 2

最后，我使用数据透视表向导将10,000个批次的范围组合在一起。

感谢您的帮助。

Answer 3

如果您想要一个不使用数据透视表的VBA解决方案，您可以尝试创建一个字典对象，并将ID用作密钥，将现金值用作值。像这样。您需要首先添加对Microsoft Scripting Runtime的引用。

Sub CreateEmployeeSum()
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim table1 As Worksheet, _
        table2 As Worksheet, finalTable As Worksheet
    'wasn't sure if you were using sheets of data
    'or actual tables - if they are actual tables,
    'you can loop through those in a similar way, look up
    'on other stackoverflow problems how


    Set table1 = wb.Sheets("Sheet1") 'first sheet of info
    Set table2 = wb.Sheets("Sheet2") 'second sheet of info
    Set finalTable = wb.Sheets("Sheet3") 'destination sheet


    'get the last row of both tables
    Dim lastRowT1 As Long, lastRowT2 As Long
    lastRowT1 = table1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lastRowT2 = table2.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    'write the info to arrays so faster to loop through
    Dim t1Array As Variant, t2Array As Variant
    t1Array = table1.Range("A1:B" & lastRowT2).Value
    t2Array = table2.Range("A1:B" & lastRowT2).Value

    'create a dictionary that maps IDs to cash value
    Dim idToCashDict As Dictionary
    Set idToCashDict = New Dictionary

    'first loop through info from first sheet
    Dim i As Long
    For i = 1 To UBound(t1Array)
        Dim idNum As String, cashVal As Double
        idNum = CStr(t1Array(i, 1))
        cashVal = CDbl(t1Array(i, 2))
        If idToCashDict.Exists(idNum) Then
            cashVal = cashVal + idToCashDict.Item(idNum)
            idToCashDict.Remove idNum
            idToCashDict.Add idNum, cashVal
        Else
            idToCashDict.Add idNum, cashVal
        End If

    Next i

    'then through second sheet, adding to cash value of
    'ids that have been seen before
    For i = 1 To UBound(t2Array)
        Dim idNum2 As String, cashVal2 As Double
        idNum2 = CStr(t2Array(i, 1))
        cashVal2 = CDbl(t2Array(i, 2))
        If idToCashDict.Exists(idNum2) Then
            cashVal2 = cashVal2 + idToCashDict.Item(idNum2)
            idToCashDict.Remove idNum2
            idToCashDict.Add idNum2, cashVal2
        Else
            idToCashDict.Add idNum2, cashVal2
        End If

    Next i


    'then write the entries from the dictionary to the
    'destination sheet
    Dim finalVal As Double, finalID As String
    i = 1
    For Each finalID In idToCashDict.Keys
        finalVal = idToCashDict.Item(finalID)
        finalTable.Range("A" & i).Value = finalID
        finalTable.Range("B" & i).Value = finalVal
        i = i + 1
    Next finalID


End Sub

如果您使用实际表，请参阅here等答案，以便以类似的方式循环遍历行。

Answer 4

这是尝试获取已排序和组合的表格。我在这里采用的一般策略是：复制现有表并使用它们来添加值，删除重复值，并对表3中的第三个组合表执行相同操作。将以下代码附加到命令按钮。

Application.ScreenUpdating = False
Dim i As Long, x As Long, n As Long, j As Long
Dim cashtotal As Integer

lastrow1 = Sheet1.Range("A1048575").End(xlUp).Row
astrow2 = Sheet2.Range("A1048575").End(xlUp).Row
cashtotal = 0
x = 1

'''''Routine to make a copy of the existing data.
For i = 1 To lastrow1
    Sheet1.Cells(i, 4) = Sheet1.Cells(i, 1)
    Sheet1.Cells(i, 5) = Sheet1.Cells(i, 2)
Next

'''''On Sheet1- Routine to remove repetitive values
For i = 2 To lastrow1
    If Sheet1.Cells(i, 4) = "" Then GoTo 10
      x = x + 1
      cashtotal = Sheet1.Cells(i, 5)
      Sheet1.Cells(x, 7) = Sheet1.Cells(i, 4)
      Sheet1.Cells(x, 8) = Sheet1.Cells(i, 5)

        For j = i + 1 To lastrow1
           If Sheet1.Cells(j, 4) = Sheet1.Cells(i, 4) Then
             cashtotal = cashtotal + Sheet1.Cells(j, 5)
             Sheet1.Cells(x, 8) = cashtotal
             Sheet1.Cells(j, 4).ClearContents
             Sheet1.Cells(j, 5).ClearContents
           End If
        Next
10
Next
x = 1

'''''On Sheet2 the following routine makes a copy of the existing data
For i = 1 To lastrow2
    Sheet2.Cells(i, 4) = Sheet2.Cells(i, 1)
    Sheet2.Cells(i, 5) = Sheet2.Cells(i, 2)
Next

'''''On sheet2 -  Routine to remove repetitive values
For i = 2 To lastrow2
    If Sheet2.Cells(i, 4) = "" Then GoTo 20
       x = x + 1
       cashtotal = Sheet2.Cells(i, 5)
       Sheet2.Cells(x, 7) = Sheet2.Cells(i, 4)
       Sheet2.Cells(x, 8) = Sheet2.Cells(i, 5)
          For j = i + 1 To lastrow2
            If Sheet2.Cells(j, 4) = Sheet2.Cells(i, 4) Then
              cashtotal = cashtotal + Sheet2.Cells(j, 5)
              Sheet2.Cells(x, 8) = cashtotal
              Sheet2.Cells(j, 4).ClearContents
              Sheet2.Cells(j, 5).ClearContents
            End If
          Next
20
Next
x = 1

'''Transfer modified tables on sheet1 and sheet2 to sheet3 in a combined table
lastrow4 = Sheet1.Range("G1048575").End(xlUp).Row

For i = 1 To lastrow4
    Sheet3.Cells(i, 1) = Sheet1.Cells(i, 7)
    Sheet3.Cells(i, 2) = Sheet1.Cells(i, 8)
Next

lastrow5 = Sheet2.Range("G1048575").End(xlUp).Row
lastrow6 = Sheet3.Range("A1048575").End(xlUp).Row

For i = 2 To lastrow5
    Sheet3.Cells(lastrow6 + i - 1, 1) = Sheet2.Cells(i, 7)
    Sheet3.Cells(lastrow6 + i - 1, 2) = Sheet2.Cells(i, 8)
Next

'''''''Routine to make a copy of the existing table
lastrow7 = Sheet3.Range("A1048575").End(xlUp).Row

For i = 1 To lastrow7
    Sheet3.Cells(i, 4) = Sheet3.Cells(i, 1)
    Sheet3.Cells(i, 5) = Sheet3.Cells(i, 2)
Next

'''''''' Routine to remove repetitive values
For i = 2 To lastrow7
    If Sheet3.Cells(i, 4) = "" Then GoTo 30
      x = x + 1
      cashtotal = Sheet3.Cells(i, 5)
      Sheet3.Cells(x, 7) = Sheet3.Cells(i, 4)
      Sheet3.Cells(x, 8) = Sheet3.Cells(i, 5)
         For j = i + 1 To lastrow7
            If Sheet3.Cells(j, 4) = Sheet3.Cells(i, 4) Then
               cashtotal = cashtotal + Sheet3.Cells(j, 5)
               Sheet3.Cells(x, 8) = cashtotal

               Sheet3.Cells(j, 4).ClearContents
               Sheet3.Cells(j, 5).ClearContents
            End If
        Next
30
Next
Application.ScreenUpdating = True

根据唯一ID将两个大表合并到一个表中

4 个答案: