比较2张数据，发现不匹配
我的工作簿中有3张，其中2张包含相似的信息 – 相同的列，但数据可能有所不同。
因此，在A列中有单位列表，在B列中有C列的温度，D列的目的地。
我想要做的是比较两张表中的数据，以显示表3中的所有不匹配 – 即如果单位编号（A）匹配，查找内容（B），温度（c）和目的地（D）中的不匹配， 。 如果有任何数据不同，请将其从两张并排复制到第三张上。
然后，比较单位数字 – 如果在一张表格中find了一个数字，但是没有在另一张表格中，则将其突出显示为红色，如果两个表格中的数字匹配，则以黄色突出显示或使颜色保持不变。
这是我到目前为止：
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 但代码无法正常工作 – 即没有列出输出表中存在的不匹配，也不会突出显示不匹配的红色单元号。
我看到的问题是，您的数据比较是根据关键列匹配。 如果Sheet1的列A中存在Sheet2的列A中不存在的值，那么每个工作表的列B到D中剩余的值都不会被检查，也不会有任何内容被报告。 通过明智地使用Exit For ， For Each … Next语句比较键列不应该达到终止状态。 如果是这样的话，Sheet1的列A中就有一些不存在于Sheet2的列A中的东西，应该被报告。
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中的键。