vba两张表，数据对比，以某一列做标识，比如学号，要求用不同颜色比如高亮整行显示出不一样的内容

Question

数据量比较大40000+，帮忙写出vba代码，我vba刚接触，不是很强

Answer 1

Public Sub 比较不同项变色()

Dim c1 As Range, c2 As Range, c As Range, cc As Range
Dim r&, d1, n1&, n2&, iColor%, iTimer, tmp

'</*----根据实际表格，设置下面的变量值-------

Set c1 = Worksheets("sheet1").Range("A:A") '表1的数据位置
Set c2 = Worksheets("sheet2").Range("A:A") '表2的数据位置
iColor = 3 '标记的颜色,3 为红色
'----设置变量值结束----*/>

iTimer = Timer
Set c1 = Application.Intersect(c1, c1.Worksheet.UsedRange)
Set c2 = Application.Intersect(c2, c2.Worksheet.UsedRange)
If c1 Is Nothing Then MsgBox "表一无数据！请设置好初始变量。", vbCritical: Exit Sub
If c2 Is Nothing Then MsgBox "表二无数据！请设置好初始变量。", vbCritical: Exit Sub
c1.EntireRow.Interior.ColorIndex = xlNone
c2.EntireRow.Interior.ColorIndex = xlNone
Set d1 = CreateObject("Scripting.Dictionary")
For Each c In c1
tmp = CStr(c.Value)
If tmp <> "" Then
If Not d1.Exists(tmp) Then d1(tmp) = c.Row
End If
Next
For Each c In c2
tmp = CStr(c.Value)
If tmp <> "" Then
If d1.Exists(tmp) Then
d1(tmp) = ""
Else
n2 = n2 + 1
c.EntireRow.Interior.ColorIndex = iColor
End If
End If
Next
tmp = d1.items
With c1.Worksheet
For r = LBound(tmp) To UBound(tmp)
If tmp(r) <> "" Then
n1 = n1 + 1
.Rows(Val(tmp(r))).Interior.ColorIndex = iColor
End If
Next
End With
MsgBox "ok！共找到 " & n1 + n2 & " 项不同,其中：" & vbCrLf & vbCrLf & _
"表一中：" & n1 & " 项" & vbCrLf & _
"表二中：" & n2 & " 项" & vbCrLf & vbCrLf & _
"用 时：" & Format(Timer - iTimer, "0.0 秒")
End Sub