vba - 在两个表中查找不相同的文本

Question

问题:
我正在使用 Excel 2010 VBA 来查找两个表之间相同结构元素(例如“123_789”)和相同错误代码(例如“ER005”)的不同(很长)错误文本。如果结果不相同，则在第一个表格的单元格中将背景颜色设置为黄色。

这就像比较两种错误协议(protocol)(新的和旧的)以找出一个错误代码和结构元素的哪些错误文本不同。

可以为多个结构元素找到一个错误代码。一个结构元素可以有多个错误代码，但一行只有一个错误代码。

文本是可变的。

示例:
表格1:

|结构元素|错误码|错误文本|
|---------|-------|--------|
| 123_456 | ER001 |文本
| 123_789 | ER001 |文本
| 123_789 | ER005 | Textnew <-这是要着色的文本单元格
| 123_456 | ER005 |文本1
| 123_456 | ER006 |文本

表2:

|结构元素|错误码|错误文本|
|---------|-------|--------|
| 123_456 | ER001 |文本
| 123_789 | ER001 |文本
| 123_789 | ER005 |文本
| 123_456 | ER005 |文本1
| 123_456 | ER006 |文本

我将结构元素与错误代码和错误文本连接到每个表的一个大字符串并将其写入 table1。
错误文本本身可能非常大(这就是我比较找出差异的原因)。

之后，将新 table1.Range1 的每个单元格与整个新 table1.Range2(来自 table2)进行比较，并对任何不匹配进行着色。
不幸的是，table1 中的原始错误文本没有着色。

被描述为一个 Excel 函数，它可能几乎是

=IF(EXACT(A2&B2&E2;'Tab2'!A2&'Tab2'!B2&'Tab2'!E2);"";'Tab1'!$A$1)

但是这个词
1)“A2&B2&E2 ”在每一行的循环中(对于每个...下一个)
2)“'Tab2'!A2&'Tab2'!B2&'Tab2'!E2”应该是一个范围，而不是比较相等的行
3) """;'Tab1'!$A$1 "如果你没有匹配，应该给背景着色，否则什么也不做

到目前为止，我未完成的 VBA 解决方案非常慢，例如Range1 中的 450 个值将每个值与 Range2 中的所有 550 个值进行比较。欢迎更有效的解决方案。

这是我当前未优化的代码:

Sub CompareProtocollTexts()

    Dim column1 As String, column2 As String, column3 As String
    Dim range1 As Range, range2 As Range, c As Range, zelle, zellen

    column1 = 1 ' Column with Structure Element
    column2 = 2 ' Column with Error Code
    column3 = 3 ' Column with Error Text

    Worksheets("Table1").Select

    'first Table
    LastRow1 = Sheets("Table1").UsedRange.SpecialCells(xlCellTypeLastCell).Row
    For i = 2 To LastRow1
        Range("F" & i).FormulaR1C1 = "=CONCATENATE(Table1!R" & i & "C" & column1 & ", Table1!R" & Reihe & "C" & column2 & ", Table1!R" & Reihe & "C" & column3 & ")"
        Range("F" & i).Copy
        Range("F" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next i

    'second Table
    LastRow2 = Sheets("Table2").UsedRange.SpecialCells(xlCellTypeLastCell).Row
    For t = 2 To LastRow2
        Range("G" & t).FormulaR1C1 = "=CONCATENATE(Table2!R" & t & "C" & column1 & ", Table2!R" & Reihe & "C" & column2 & ", Table2!R" & Reihe & "C" & column3 & ")"
        Range("G" & t).Copy
        Range("G" & t).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next t

    'now compare ranges in the new columns (F is 6; G is 7)
    Set wkTab1 = Worksheets("Table1")
    LastRowF = ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row
    LastRowG = ActiveSheet.Cells(Rows.Count, 7).End(xlUp).Row

    Set range1 = wkTab1.Range("F2:F" & LastRowF)
    Set range2 = wkTab1.Range("G2:G" & LastRowF)

    For Each zellen In range1
        For Each zelle In range2
            If zellen.Value = zelle.Value And zellen.Value <> "" Then
                zellen.Font.ColorIndex = xlColorIndexAutomatic
                zellen.Interior.ColorIndex = xlColorIndexAutomatic
                Exit For
            Else:
                'colorize non-identical positions
                zellen.Interior.ColorIndex = 6 '(green = 4 ; yellow = 6 ; red = 3)
                'currently missing: colorize other cell (if matches F4 then colorize C4) in same line
            End If
        Next
    Next

End Sub

Answer 1

这段代码运行得更快。基本思想是集中使用Excel内置的强大方法，不需要任何中间连接。
这里我使用 CountIfs ，从而获得最佳性能。

Sub CompareProtocollTexts()
    Dim range1 As Range, range2 As Range, r As Range
    Application.ScreenUpdating = False

   With Sheets("Table1")
        Set range1 = .Range(.Cells(2, 22), .Cells(.Rows.Count, 9).End(xlUp))
    End With
    With Sheets("Table2")
        Set range2 = .Range(.Cells(2, 22), .Cells(.Rows.Count, 9).End(xlUp))
    End With

    For Each r In range1.Rows
        With range2
            If Application.CountIfs(.Columns(1), r.Cells(1).Value2, _
              .Columns(13), r.Cells(13).Value2, .Columns(14), r.Cells(14).Value2) = 0 Then _
                r.Interior.ColorIndex = 6
        End With
    Next
    Application.ScreenUpdating = True
End Sub