Question

问题：
我正在使用Excel 2010 VBA为相同的结构元素（例如＆＃34; 123_789＆＃34;）和相同的错误代码（例如＆＃34; ER005＆＃34;）之间找到不相同（非常长）的错误文本2桌。如果结果不相同，请在第一个表格的单元格中将背景颜色设置为黄色。

比较两个错误协议（新旧）以找出一个错误代码和结构元素的错误文本不同。

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

文字是可变的。

示例：
表1：

| StructureElement |错误代码| ERRORTEXT |
| --------- | ------- | -------- |
| 123_456 | ER001 |文字
| 123_789 | ER001 |文字
| 123_789 | ER005 | Textnew＆lt; -this是要着色的文本单元格 | 123_456 | ER005 |文本1
| 123_456 | ER006 |文本

表2：

| StructureElement |错误代码| ERRORTEXT |
| --------- | ------- | -------- |
| 123_456 | ER001 |文字
| 123_789 | ER001 |文字
| 123_789 | ER005 | Textold
| 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）＆＃34; A2＆amp; B2＆amp; E2＆＃34;每一行都是循环（每个......下一个） 2）＆＃34; ＆＃39; Tab2＆＃39;！A2＆amp;＆＃39; Tab2＆＃39;！B2＆amp;＆＃39; Tab2＆＃39;！E2＆＃34;应该是一个范围，而不是比较相等的行 3）＆＃34; ＆＃34;＆＃34;;＆＃39; Tab1＆＃39;！$ 1 $＆＃34;如果没有匹配则应该为背景着色，否则不做任何事

我未完成的VBA解决方案到目前为止非常缓慢，例如450 Range1中的值将每个值与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

在两个表

1 个答案: