VBA实战技巧36：比较两组数据并高亮显示不匹配的字母或单词

引言：本文学习整理自chandoo.org的文章《Compare 2 sets of databy letter or word & highlight mismatches [vba]》，供有兴趣的朋友学习参考。

假设你正在查看下图1所示的2列表，并且想知道每行中的两组数据哪里不同。

图1

可以使用一个简单的VBA程序来比较这2个列表并突出显示不匹配的字母或单词。演示如下图2所示。

图2

当开始创建这样的宏时，第一步是定义基本算法（简单的逻辑步骤）。要比较两组数据，需要执行以下操作：

1.对于列1中的每个项目

2.获取列2中的对应项

3.如果它们不匹配

4.对于单词匹配

（1）对于第一个文本中的每个单词

（2）在第二个文本中获取相应的单词

（3）相比较

（4）如果不匹配，以红色突出显示

（5）重复其他词

5.对于字母匹配

（1）找到第一个不匹配的字母

（2）在第二个文本中突出显示自该点的所有字母

6.重复列1 中的下一项

7.完毕

一旦你写下了这个逻辑，就只需继续并在VBA代码中实现它。完整的代码如下：

Sub highlightDiffs()

Dim cell1 As Range, cell2 As Range, i As Long

Dim j As Long, k As Long, length As Long, word1 As String, word2 As String

resetColors

i = 1

For Each cell1 In Range("list1")

Set cell2 = Range("list2").Cells(i)

If Not cell1.Value2 = cell2.Value2 Then

'两个单元格都不匹配.找到第一个不匹配的单词/字符

length = Len(cell1.Value2)

If Range("wordMatch") Then

'匹配单词

j = 1

k = 1

Do

word1 = nextWord(cell1.Value2, j)

word2 = nextWord(cell2.Value2, k)

If Not word1 = word2 Then

With cell2.Characters(k, Len(word2)).Font

.Color = -16776961

End With

End If

j = j + Len(word1) + 1

k = k + Len(word2) + 1

Loop While j <= length

If k <= Len(cell2.Value2) Then

With cell2.Characters(k, Len(cell2.Value2) - k + 1).Font

.Color = -16776961

End With

End If

Else

'匹配字母

For j = 1 To length

If Not cell1.Characters(j,1).Text = cell2.Characters(j, 1).Text _

Then Exit For

Next j

If j <= Len(cell2.Value2) Then

With cell2.Characters(j, Len(cell2.Value2) - j + 1).Font

.Color = -16776961

End With

End If

End If

End If

i = i+ 1

Next cell1

End Sub

Sub resetColors()

'重置颜色

With Range("list2").Font

.ColorIndex = xlAutomatic

.TintAndShade = 0

End With

End Sub

Function nextWord(fromThis As String, startHere As Long) As String

'返回从start Here开始以分隔符 ., ?!"';结束的下一个单词

Dim i As Long

Dim delim As String

delim =" .,?!"""

startHere= IIf(delim Like "*" & Mid(fromThis, startHere, 1) &"*", startHere + 1, startHere)

For i =startHere To Len(fromThis)

If delim Like "*" & Mid(fromThis, i, 1) & "*" Then Exit For

Next i

nextWord= Trim(Mid(fromThis, startHere, i - startHere))

End Function