比较2张数据并查找不匹配 [英] Compare data from 2 sheets and find mismatches

问题描述

我的工作簿中有3个工作表，其中2个包含类似的信息 - 相同的列，但数据可能会有所不同。

I've got 3 sheets in my workbook, 2 of them contain similar information - the same columns but the data may vary.

是单位列表，则在列B中有内容，在列C中是温度，在列D中是目的地。

So, in column A there is list of units, then in column B there is contents, in column C - temperature, and in column D - destination.

我要做的是比较来自2张的数据显示在表3中的所有不匹配 - 即如果单位数（A）匹配，则查找内容（B），温度（c）和目的地（D）中的不匹配。如果任何数据不同，请将它们从两张纸并排复制到第三张纸上。

What I'm trying to do is compare the data from 2 sheets to show all the mismatches in Sheet 3 - ie if unit number (A) matches, look for mismatches in contents (B), temperature (c) and destination (D). If any of that data is different, copy it side by side from two sheets onto the third one.

然后，比较单位编号 - 如果在一张纸上找到一个数字但不在另一个，突出显示为红色，如果两个列表中的数字匹配，突出显示为黄色或保持颜色相同。

Then, compare unit numbers - if a number is found in one sheet but not in the other, highlight it in red, if the numbers from both lists match, highlight in yellow OR leave color the same.

这是我到目前为止：

Option Explicit

Const MySheet1 As String = "Sheet1" 'list 1

Const MySheet2 As String = "Sheet2" 'list 2

Const MySheet3 As String = "Sheet3" 'output sheet

Sub CompareLists()

    Dim List1() As Variant, List2() As Variant
    Dim LC1 As Long, LC2 As Long, ORow As Long
    Dim Loop1 As Long, Loop2 As Long, Loop3 As Long

    ORow = 4
    With ThisWorkbook
        LC1 = .Sheets(MySheet1).UsedRange.Rows.Count
        LC2 = .Sheets(MySheet2).UsedRange.Rows.Count
        List1 = .Sheets(MySheet1).Range("A1:D" & LC1).Value
        List2 = .Sheets(MySheet2).Range("A1:D" & LC2).Value

For Loop2 = 2 To LC2

    If Len(List2(Loop2, 3)) > 0 Then
        List2(Loop2, 3) = Trim(List2(Loop2, 3))
    End If

Next Loop2

        With .Sheets(MySheet3)
            .Cells.ClearContents
            .Range("A1").Value = "Mismatched Records"
            .Range("A3").Value = "Unit Number"
            .Range("B2").Value = MySheet1
            .Range("E2").Value = MySheet2
            .Range("B3").Value = "Type"
            .Range("C3").Value = "Required Temperature"
            .Range("D3").Value = "Final Destination"
            .Range("E3").Value = "Type"
            .Range("F3").Value = "Required Temperature"
            .Range("G3").Value = "Final Destination"
        End With
        For Loop1 = 2 To LC1
            For Loop2 = 2 To LC2
                If Trim(List1(Loop1, 1)) = Trim(List2(Loop2, 1)) Then
                    For Loop3 = 2 To 4
                        If Trim(List1(Loop1, Loop3)) <> Trim(List2(Loop2, Loop3)) Then
                            With .Sheets(MySheet3)
                                .Range("A" & ORow).Value = List1(Loop1, 1)
                                .Range("B" & ORow).Value = List1(Loop1, 2)
                                .Range("C" & ORow).Value = List1(Loop1, 3)
                                .Range("D" & ORow).Value = List1(Loop1, 4)
                                .Range("E" & ORow).Value = List2(Loop2, 2)
                                .Range("F" & ORow).Value = List2(Loop2, 3)
                                .Range("G" & ORow).Value = List2(Loop2, 4)
                            End With
                            ORow = ORow + 1
                            Exit For
                        End If
                    Next Loop3
                    Exit For
                Else
                    DoEvents
                End If
            Next Loop2
        Next Loop1
    End With

    MsgBox "Finished", vbInformation, "Done!"

End Sub

但是代码不能正常工作

推荐答案

问题I：不匹配的单位数字，看到的是你的数据比较是基于关键列匹配。如果Sheet1的列A中有一个值不存在于Sheet2的列A中，则不检查每个工作表的列B到D中的剩余值，并且不会报告任何内容。您慎重使用退出， For Each ... Next语句，比较键列永远不会到达它的终止。如果它是，那么在Sheet1的列A中有一些在Sheet2的列A中不存在，并且应该被报告。

The problem I'm seeing is that your data comparison is predicated on the key columns matching. If there is a value in Sheet1's column A that does not exist in Sheet2's column A then the remaining values from each worksheet's column B through D are not checked and nothing gets reported. With your judicious use of Exit For, the For Each...Next Statement that compares the key column should never reach its termination. If it does then there is something in Sheet1 's column A that does not exist in Sheet2's column A and that should be reported.

Option Explicit

Const MySheet1 As String = "Sheet1" 'list 1
Const MySheet2 As String = "Sheet2" 'list 2
Const MySheet3 As String = "Sheet3" 'output sheet

Sub CompareLists2()

    Dim List1 As Variant, List2 As Variant
    Dim LC1 As Long, LC2 As Long, ORow As Long
    Dim Loop1 As Long, Loop2 As Long, Loop3 As Long

    ORow = 4
    With ThisWorkbook
        LC1 = .Sheets(MySheet1).UsedRange.Rows.Count
        LC2 = .Sheets(MySheet2).UsedRange.Rows.Count
        List1 = .Sheets(MySheet1).Range("A1:D" & LC1).Value
        List2 = .Sheets(MySheet2).Range("A1:D" & LC2).Value

        For Loop2 = 2 To LC2
            List2(Loop2, 3) = Trim(List2(Loop2, 3))
        Next Loop2

        With .Sheets(MySheet3)
            .Cells.ClearContents
            .Range("A1").Value = "Mismatched Records"
            .Range("A3").Value = "Unit Number"
            .Range("B2").Value = MySheet1
            .Range("E2").Value = MySheet2
            .Range("B3").Value = "Type"
            .Range("C3").Value = "Required Temperature"
            .Range("D3").Value = "Final Destination"
            .Range("E3").Value = "Type"
            .Range("F3").Value = "Required Temperature"
            .Range("G3").Value = "Final Destination"
        End With

        For Loop1 = 2 To LC1
            For Loop2 = 2 To LC2
                If Trim(List1(Loop1, 1)) = Trim(List2(Loop2, 1)) Then
                    For Loop3 = 2 To 4
                        If Trim(List1(Loop1, Loop3)) <> Trim(List2(Loop2, Loop3)) Then
                            With .Sheets(MySheet3)
                                .Range("A" & ORow).Value = List1(Loop1, 1)
                                .Range("B" & ORow).Value = List1(Loop1, 2)
                                .Range("C" & ORow).Value = List1(Loop1, 3)
                                .Range("D" & ORow).Value = List1(Loop1, 4)
                                .Range("E" & ORow).Value = List2(Loop2, 2)
                                .Range("F" & ORow).Value = List2(Loop2, 3)
                                .Range("G" & ORow).Value = List2(Loop2, 4)
                            End With
                            ORow = ORow + 1
                            Exit For
                        End If
                    Next Loop3
                    Exit For
                ElseIf Loop2 = LC2 Then
                    'last loop and no match
                    'this reports sheet1 missing from sheet2
                    With .Sheets(MySheet3)
                        .Range("A" & ORow).Value = List1(Loop1, 1)
                        .Range("B" & ORow).Value = List1(Loop1, 2)
                        .Range("C" & ORow).Value = List1(Loop1, 3)
                        .Range("D" & ORow).Value = List1(Loop1, 4)
                    End With
                    ORow = ORow + 1
                End If
            Next Loop2
        Next Loop1

        'add a reverse loop for Sheet2 column A keys missing from Sheet1's column A
        For Loop2 = 2 To UBound(List2, 1)
            For Loop1 = 2 To UBound(List1, 1)
                If Trim(List1(Loop1, 1)) = Trim(List2(Loop2, 1)) Then
                    Exit For
                ElseIf Loop1 = UBound(List1, 1) Then
                    'last loop and no match
                    'this reports sheet2 missing from sheet1
                    With .Sheets(MySheet3)
                        .Range("A" & ORow).Value = List2(Loop2, 1)
                        .Range("E" & ORow).Value = List2(Loop2, 2)
                        .Range("F" & ORow).Value = List2(Loop2, 3)
                        .Range("G" & ORow).Value = List2(Loop2, 4)
                    End With
                    ORow = ORow + 1
                End If
            Next Loop1
        Next Loop2

    End With

    MsgBox "Finished", vbInformation, "Done!"

End Sub

我添加了一个反向循环在Sheet1的列A中找不到来自Sheet2的列A的键。

I've added a half-reverse loop to also catch keys from Sheet2's column A that are not found in Sheet1's column A.

这篇关于比较2张数据并查找不匹配的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！