这个用Ctrl m同样可以完成。
想用不同颜色显示一对一核对结果？当然可以！
看到这么好用的核对功能，你是不是也想试一下Ctrl m ? 先别试，因为你试了也没效果。你需要跟小编一起做以下以步才可使用。
第1步 打开你要做核对的表格，工作表标签右键 - 点击查看代码。在弹出的新窗口插入 - 模块，然后复制下面的代码粘贴到右侧窗口中。
Sub 核对()
Dim k
k = 3
If k = 1 Then
普通核对
ElseIf k = 2 Then
单色一对一核对
ElseIf k = 3 Then
多色一对一核对
End If
End Sub
Sub 普通核对()
Dim arr1, arr2
Dim 红 As Byte, 绿 As Byte, 黄 As Byte
Set rg = Selection
If rg.Areas.Count <> 2 Then Exit Sub
arr1 = rg.Areas(1)
arr2 = rg.Areas(2)
'开始核对
'核对前删除颜色
rg.Interior.ColorIndex = xlNone
For x = 1 To UBound(arr1)
For y = 1 To UBound(arr2)
If arr1(x, 1) = arr2(y, 1) Then
rg.Areas(1)(x).Interior.Color = RGB(255, 199, 206)
rg.Areas(2)(y).Interior.Color = RGB(255, 199, 206)
End If
Next y
Next x
End Sub
Sub 单色一对一核对()
Dim arr1, arr2, arr3(1 To 10000)
Dim 红 As Byte, 绿 As Byte, 黄 As Byte
Set rg = Selection
If rg.Areas.Count <> 2 Then Exit Sub
arr1 = rg.Areas(1)
arr2 = rg.Areas(2)
'开始核对
'核对前删除颜色
rg.Interior.ColorIndex = xlNone
For x = 1 To UBound(arr1)
For y = 1 To UBound(arr2)
If arr1(x, 1) = arr2(y, 1) And arr3(y) <> 1 Then
rg.Areas(1)(x).Interior.Color = RGB(255, 199, 206)
rg.Areas(2)(y).Interior.Color = RGB(255, 199, 206)
arr3(y) = 1
GoTo 10
End If
Next y
10:
Next x
End Sub
Sub 多色一对一核对()
Dim arr1, arr2, arr3(1 To 10000)
Dim 红 As Byte, 绿 As Byte, 黄 As Byte
Set rg = Selection
If rg.Areas.Count <> 2 Then Exit Sub
arr1 = rg.Areas(1)
arr2 = rg.Areas(2)
'开始核对
'核对前删除颜色
rg.Interior.ColorIndex = xlNone
For x = 1 To UBound(arr1)
For y = 1 To UBound(arr2)
If arr1(x, 1) = arr2(y, 1) And arr3(y) <> 1 Then
红 = Application.RandBetween(1, 255)
绿 = Application.RandBetween(1, 255)
黄 = Application.RandBetween(1, 255)
rg.Areas(1)(x).Interior.Color = RGB(红, 绿, 黄)
rg.Areas(2)(y).Interior.Color = RGB(红, 绿, 黄)
arr3(y) = 1
GoTo 10
End If
Next y
10:
Next x
End Sub
注：修改代码中K的值即可在几种核对模式中切换（1是普通核对，2是单色一对一核对，3是多色一对一核对）
Sub 核对()
Dim k
k = 3
If k = 1 Then
普通核对
ElseIf k = 2 Then
单色一对一核对
ElseIf k = 3 Then
多色一对一核对
End If
第2步 开发工具 - 宏 - 选取“核对” - 选项 - 快捷键后输入字母m
