VBA-比较两张图纸上的表格是否存在差异_Vba_Excel

VBA-比较两张图纸上的表格是否存在差异

vba excel

VBA-比较两张图纸上的表格是否存在差异,vba,excel,Vba,Excel,我是VBA新手，正在寻找帮助，帮助我编写一个sub或代码，可以比较两个不同工作表上两个表的同一列（B），并将它们合并到第一个工作表上的一个表中。我已经研究过如何做到这一点，但对于使用范围或联合作为解决方案，我真的感到困惑。我想让它查找表2中b列中缺少的项目（该列将有一个动态的、但已知的名称存储在变量中），并将整行添加到表1中（命名为“Dump”，在d列上附加注释，并检查“Dump”中是否有行，但在另一张表中没有。只需比较两张表中的b列，因为b列是关键这里有一个例子，我正在寻找给定的2张数据表和

我是VBA新手，正在寻找帮助，帮助我编写一个sub或代码，可以比较两个不同工作表上两个表的同一列（B），并将它们合并到第一个工作表上的一个表中。我已经研究过如何做到这一点，但对于使用范围或联合作为解决方案，我真的感到困惑。我想让它查找表2中b列中缺少的项目（该列将有一个动态的、但已知的名称存储在变量中），并将整行添加到表1中（命名为“Dump”，在d列上附加注释，并检查“Dump”中是否有行，但在另一张表中没有。只需比较两张表中的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  |                                       |
+--------------------+-----+-----------+---------------------------------------+

行放置在何处并不重要，因为稍后会对其进行排序。非常感谢您的帮助

比较两个工作表中现有数据的最快方法（如果存在键）是使用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

注意：这并不是您想要的，但是……假设

表示列表中存在数据，

null

表示数据不存在：

c44

仅存在于

ICD

列表中，

c49

仅存在于

Dump

列表中

有关更多信息，请参阅：

比较两个工作表中现有数据的最快方法（如果存在键）是使用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

注意：这并不是您想要的，但是……假设

表示列表中存在数据，

null

表示数据不存在：

c44

仅存在于

ICD

列表中，

c49

仅存在于

Dump

列表中

有关更多信息，请参阅：

这里，我为您准备了一个。我的代码可以为匹配两张表提供正确答案。但是顺序与您的不相等。我认为无论结果行的顺序如何。好的，让我们检查我的代码：

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

公共子匹配行（）
Dim转储表、ICD表、输出表作为工作表
Dim startRow、outputRow、tempDumpRow、tempICDRow、icdRowCount、finishedICDIndex作为整数
Dim finishedICD（）作为字符串
Dim isExist为布尔型
“床单
设置转储页=页（“转储”）
设置ICD图纸=图纸（“ICD”）
设置outputSheet=工作表（“输出”）
'为数据设置每个工作表的起始行
startRow=1
outputRow=1
'从ICD表获取行数
icdRowCount=icdSheet.Range（“A:C”）.End（xlDown）.row
'设置索引
finishedICDIndex=0
'重新定义数组
ReDim finishedICD（0到icdRowCount-1）
'设置起始行
tempDumpRow=startRow
'在这里，我循环使用或状态，您可以将其修改为，并根据需要启动
在dumpSheet.Range（“A”&tempDumpRow）”或dumpSheet.Range（“B”&tempDumpRow）”或dumpSheet.Range（“C”&tempDumpRow）”期间执行
'重置存在标志
isExist=False
'循环ICD表中的所有行
对于tempICDRow=1到icdRowCount步骤1
'如果行未完成检查。
如果UBound（过滤器（finishedICD，tempICDRow））<0，则
'如果所有单元格都相等
如果dumpSheet.Range（“A”&tempDumpRow）=icdSheet.Range（“A”&tempDumpRow）和_
dumpSheet.Range（“B”和tempDumpRow）=icdSheet.Range（“B”和tempICDRow）和_
dumpSheet.Range（“C”和tempDumpRow）=icdSheet.Range（“C”和tempICDRow）然后
'将true设置为存在标志
isExist=True
'存储完成的行
finishedICD（finishedicdex）=tempICDRow
finishedICDIndex=finishedICDIndex+1
"退出循环",
退出
如果结束
如果结束
下一个临时工
"显示结果"
outputSheet.Range（“A”和outputRow）=dumpSheet.Range（“A”和tempDumpRow）
outputSheet.Range（“B”和outputRow）=dumpSheet.Range（“B”和tempDumpRow）
outputSheet.Range（“C”和outputRow）=dumpSheet.Range（“C”和tempDumpRow）
如果我存在的话
outputSheet.Range（“D”和outputRow）=“”
其他的
outputSheet.Range（“D”和outputRow）=“转储”中找到但不在“ICD”中的项
如果结束
'增加输出行
outputRow=outputRow+1
“去下一排
tempDumpRow=tempDumpRow+1
环
'循环ICD表中的所有行
对于tempICDRow=1到icdRowCount步骤1
'如果行未完成检查。
如果UBound（过滤器（finishedICD，tempICDRow））<0，则
"显示结果"
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）=“ICD”中找到但不在“转储”中的项
'增加输出行
outputRow=outputRow+1
如果结束
下一个临时工
端接头

对于我的答案，我保证它将为任何数据集提供正确的答案

转储工作表数据：

ICD表数据：

这是结果：

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

这里，我为你准备了一个。我的代码可以给出匹配两张纸的正确答案。但是顺序与你的不相等。我想这与结果行的顺序无关。好的，让我们检查我的代码：

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

公共子匹配行（）
Dim转储表、ICD表、输出表作为工作表
Dim startRow、outputRow、tempDumpRow、tempICDRow、icdRowCount、finishedICDIndex作为整数