|
四段代码分别:1.检测并标注 2.检测并提示 3.检测并标注及提示 4.检测全部(不对比2列)并标注
Sub zz() Dim d, ar Set d = CreateObject("Scripting.Dictionary") ar = [a2].CurrentRegion For i = 1 To UBound(ar) d(ar(i, 1)) = d(ar(i, 1)) + 1 Next For i = 2 To UBound(ar) + 1 If d(Cells(i, 1).Value) > 1 Then Cells(i, 1).Interior.ColorIndex = 3 Next End Sub
Sub 检验() Columns("A:A").Font.ColorIndex = 0 Dim w, y As Integer For w = 4 To [a65536].End(xlUp).Row y = [a65536].End(xlUp).Row If WorksheetFunction.CountIf(Range("a2:a" & y), Range("a" & w)) >= 2 Then MsgBox "发现重复", 16, "系统提示" Range("a" & w).Font.ColorIndex = 3 End If Next End Sub
Public Sub AAA() Dim w& For w = 4 To 5000 Step 1 If Application.CountIf(Range("A4:A5000"), Range("A" & w)) >= 2 Then MsgBox "发现重复", 16, "系统提示": Application.Goto Range("A" & w): Exit Sub End If Next End Sub
Sub 检测列重复()
Set d = CreateObject("Scripting.Dictionary") lr = [b65536].End(3).Row arr = Range("A1:H" & lr) '范围(小了报错,下标越界) For i = 1 To UBound(arr) s = arr(i, 1) & arr(i, 3) & arr(i, 4) & arr(i, 5) & arr(i, 6) & arr(i, 7) & arr(i, 8) '主范围 d(s) = d(s) + 1 Next For i = 2 To UBound(arr) s = arr(i, 1) & arr(i, 3) & arr(i, 4) & arr(i, 5) & arr(i, 6) & arr(i, 7) & arr(i, 8) If d(s) > 1 Then Cells(i, 1).Interior.ColorIndex = 3 Next End Sub
|