VBA - 比较两张带有差异的表格

时间：2015-07-28 04:59:18

标签： vba excel-vba excel

我是VBA的新手，正在寻找帮助，可以编写一个子或代码，可以比较两张不同纸张上两张表的相同列（B），并将它们合并到第一张纸上的单个表中。我已经研究过如何做到这一点，我真的很困惑使用范围或联合作为解决方案。我希望它能找到工作表2中列b中缺少的项目（它将具有存储在变量中的动态但已知的名称），并将整行添加到工作表1中（命名为＆＃39;转储＆＃39;附加一个对列d进行注释，以及检查＆＃39;转储中的行但不存在于另一个工作表中。它只需要比较两个工作表的b列，因为b列是关键。

以下是给出2张数据和最终输出的一个例子。

**Sheet 'Dump'**
+---------------------------+-----+------------------+---+
|             A             |  B  |        C         | D |
+---------------------------+-----+------------------+---+
| v62: Cheetah Mail         | v62 | 206              |   |
| c49: Report Suite         | c49 | appid            |   |
| v75: Message Type         | v75 | NDS Error        |   |
| v42: Core                 | v42 | fd8000d7         |   |
| c37: Message Key          | c37 | fd8000d7         |   |
+---------------------------+-----+------------------+---+

**Sheet 'ICD'**
+---------------------------+-----+-----------+---+
|             A             |  B  |     C     | D |
+---------------------------+-----+-----------+---+
| v62: Cheetah Mail         | v62 | 206       |   |
| c44: Portal               | c44 | polo      |   |
| v75: Message Type         | v75 | NDS Error |   |
| v42: Core                 | v42 | fd8000d7  |   |
| c37: Message Key          | c37 | fd8000d7  |   |
+---------------------------+-----+-----------+---+

Output Sheet 'Dump'
+--------------------+-----+-----------+---------------------------------------+
|         A          |  B  |     C     |                   D                   |
+--------------------+-----+-----------+---------------------------------------+
| v62: Cheetah Mail  | v62 | 206       |                                       |
| c44: Portal        | c44 | polo      | Item found in "ICD" but not in "Dump" |
| c49: Report Suite  | c49 | appid     | Item found in "Dump" but not in "ICD" |
| v75: Message Type  | v75 | NDS Error |                                       |
| v42: Core          | v42 | fd8000d7  |                                       |
| c37: Message Key   | c37 | fd8000d7  |                                       |
+--------------------+-----+-----------+---------------------------------------+

放置行的位置并不重要，因为它将在稍后排序。非常感谢您的帮助

2 个答案:

答案 0 :(得分：1)

在这里，我找到了一个给你。我的代码可以给出匹配两张表的正确答案。但订单与你的不相同。我认为不管结果行的顺序是什么。好的，让我们检查一下代码：

Public Sub matchRow()

    Dim dumpSheet, icdSheet, outputSheet As Worksheet
    Dim startRow, outputRow, tempDumpRow, tempICDRow, icdRowCount, finishedICDIndex As Integer
    Dim finishedICD() As String
    Dim isExist As Boolean

    'Set sheets
    Set dumpSheet = Sheets("Dump")
    Set icdSheet = Sheets("ICD")
    Set outputSheet = Sheets("Output")

    'Set start row of each sheet for data
    startRow = 1
    outputRow = 1

    'Get row count from ICD sheet
    icdRowCount = icdSheet.Range("A:C").End(xlDown).row

    'Set index
    finishedICDIndex = 0

    'Re-define array
    ReDim finishedICD(0 To icdRowCount - 1)

    'Set the start row
    tempDumpRow = startRow

    'Here I looped with OR state, you can modify it to AND start if you want
    Do While dumpSheet.Range("A" & tempDumpRow) <> "" Or dumpSheet.Range("B" & tempDumpRow) <> "" Or dumpSheet.Range("C" & tempDumpRow) <> ""

        'Reset exist flag
        isExist = False

        'loop all row in ICD sheet
        For tempICDRow = 1 To icdRowCount Step 1

            'If row is not finished for checking.
            If UBound(Filter(finishedICD, tempICDRow)) < 0 Then

                'If all cell are equal
                If dumpSheet.Range("A" & tempDumpRow) = icdSheet.Range("A" & tempICDRow) And _
                   dumpSheet.Range("B" & tempDumpRow) = icdSheet.Range("B" & tempICDRow) And _
                   dumpSheet.Range("C" & tempDumpRow) = icdSheet.Range("C" & tempICDRow) Then

                    'Set true to exist flag
                    isExist = True

                    'Store finished row
                    finishedICD(finishedICDIndex) = tempICDRow

                    finishedICDIndex = finishedICDIndex + 1

                    'exit looping
                    Exit For

                End If

            End If

        Next tempICDRow

        'Show result
        outputSheet.Range("A" & outputRow) = dumpSheet.Range("A" & tempDumpRow)
        outputSheet.Range("B" & outputRow) = dumpSheet.Range("B" & tempDumpRow)
        outputSheet.Range("C" & outputRow) = dumpSheet.Range("C" & tempDumpRow)

        If isExist Then
            outputSheet.Range("D" & outputRow) = ""
        Else
            outputSheet.Range("D" & outputRow) = "Item found in ""Dump"" but not in ""ICD"""
        End If

        'increase output row
        outputRow = outputRow + 1

        'go next row
        tempDumpRow = tempDumpRow + 1

    Loop

    'loop all row in ICD sheet
    For tempICDRow = 1 To icdRowCount Step 1

        'If row is not finished for checking.
        If UBound(Filter(finishedICD, tempICDRow)) < 0 Then

            'Show result
            outputSheet.Range("A" & outputRow) = icdSheet.Range("A" & tempICDRow)
            outputSheet.Range("B" & outputRow) = icdSheet.Range("B" & tempICDRow)
            outputSheet.Range("C" & outputRow) = icdSheet.Range("C" & tempICDRow)
            outputSheet.Range("D" & outputRow) = "Item found in ""ICD"" but not in ""Dump"""

            'increase output row
            outputRow = outputRow + 1

        End If

    Next tempICDRow

End Sub

我保证我的回答是它会为任何数据集提供正确的答案。在这里，我的代码的测试证据。

转储表数据：

Dump Sheet

ICD表数据：

ICD Sheet

结果如下：

Result Sheet

我知道这个答案和你的答案不一样。但我相信这对你有所帮助。

答案 1 :(得分：0)

比较两张纸中存在的数据的最快方法（如果存在键）是使用ADODB对象。请看一下例子，并在代码中阅读评论。

Sub CompareDataViaSql()
'declare variables
Dim i As Long, vSheets As Variant, sSql As String
Dim srcWsh As Worksheet, dstWsh As Worksheet
Dim oConn As ADODB.Connection, oRst As ADODB.Recordset

'on error go to error handler
On Error GoTo Err_CompareDataViaSql

'add destination sheet
Set dstWsh = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
dstWsh.Name = "ResultList_" & Format(Now, "yyyyMMddHHss")

'define collection of sheets to loop through
vSheets = Array("Dump", "ICD")

'loop through the collection of sheets
'build sql command
For i = LBound(vSheets) To UBound(vSheets)
    Set srcWsh = ThisWorkbook.Worksheets(vSheets(i))
    sSql = sSql & "SELECT [F1], [F2], [F3], '" & srcWsh.Name & "' AS [F4]" & vbCr & _
        "FROM [" & srcWsh.Name & "$" & Replace(srcWsh.UsedRange.Address, "$", "") & "]" & vbCr & _
        "UNION ALL" & vbCr
Next i

'remove last UNION ALL command
sSql = Left(sSql, Len(sSql) - 10)
'continue building sql command
'in this case - pivot table
sSql = "TRANSFORM COUNT(T.[F2])" & vbCr & _
       "SELECT T.[F1], T.[F2], T.[F3]" & vbCr & _
        "FROM (" & sSql & ") AS T" & vbCr & _
        "GROUP BY T.[F1], T.[F2], T.[F3]" & vbCr & _
        "PIVOT(T.[F4])"

'create new adodb connection
Set oConn = New ADODB.Connection
With oConn
    'define connection string
    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";" & _
            "Extended Properties='Excel 12.0 Macro;HDR=NO';"
    'open connection
    .Open
End With

'create new adodb recordset
Set oRst = New ADODB.Recordset
'open recordset
oRst.Open sSql, oConn, adOpenStatic, adLockReadOnly

'add headers
For i = 0 To oRst.Fields.Count - 1
    dstWsh.Range("A1").Offset(ColumnOffset:=i) = oRst.Fields(i).Name
Next
i = i - 1
With dstWsh.Range("A1:" & dstWsh.Range("A1").Offset(ColumnOffset:=i).Address)
    .Font.Bold = True
    .Font.Color = vbRed
    .Interior.Color = vbYellow
End With

'define destination row
i = 2
'copy data from recordset
dstWsh.Range("A" & i).CopyFromRecordset oRst
'fit columns width
dstWsh.UsedRange.Columns.AutoFit

'clean up
Exit_CompareDataViaSql:
    On Error Resume Next
    oRst.Close
    Set oRst = Nothing
    oConn.Close
    Set oConn = Nothing
    Set srcWsh = Nothing
    Set dstWsh = Nothing
    Exit Sub

'error handler
Err_CompareDataViaSql:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_CompareDataViaSql

End Sub

结果：

 F1                          F2      F3         Dump    ICD
 c37: Message Key            c37     fd8000d7   1       1
 c44: Portal                 c44     polo               1
 c49: Report Suite           c49     appid      1   
 v42: Core                   v42     fd8000d7   1       1
 v62: Cheetah Mail           v62     206        1       1
 v75: Message Type           v75     NDS Error  1       1

注意：这不是您想要的，但是......假设1表示列表中存在数据而null表示数据不存在：c44仅存在于ICD列表和c49仅存在于Dump列表中。

有关详细信息，请参阅：TRANSFORM (MS Access)

相关问题
最新问题