在两个表中查找不同的文本
问题：
我正在使用Excel 2010 VBA为两个表之间的相同结构元素（例如“123_789”）和相同的错误代码（例如“ER005”）find不同的（非常长的）错误文本。 如果结果不相同，则在第一个表格的单元格中将背景颜色设置为黄色。
这就像比较两个错误协议（新旧），找出一个错误代码和结构元素的错误文本是不同的。
一个错误代码可以find几个结构元素。 一个Structure元素可以有多个错误代码，但是一行只有一个错误代码。
文本是可变的。
例：
表格1：
| StructureElement | 错误代码| ERRORTEXT |
| ——— | ——- | ——– |
| 123_456 | ER001 | 文本
| 123_789 | ER001 | 文本
| 123_789 | ER005 | Textnew < – 这是要着色的文本单元格
| 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 | 文本
我将错误代码和错误文本的结构元素连接到每个表的一个大string，并将其写入到table1中。 错误文本本身可能非常巨大（这就是为什么我要比较以找出差异）。
之后，新table1.Range1的每个单元格将与全新的table1.Range2（来自table2）进行比较，任何不匹配都会着色。 不幸的是，table1中的原始错误文本没有彩色化。
描述为一个Excelfunction，可能会差不多
=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解决scheme现在非常慢，例如Range1中的每个值与Range2中的所有550个值进行比较。 欢迎提供更高效的解决scheme
这是我目前未经优化的代码：
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
此代码运行得更快。 其基本思想是密集使用内置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