|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub 查找标红()
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.AutoFilter.Sort.SortFields.Clear
ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Range _
("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveSheet.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter
Set d = CreateObject("scripting.dictionary")
k = Range("A1").End(xlDown).Row
arr = Range("A2:A" & k)
For i = 1 To k - 1
d(arr(i, 1)) = ""
Next
t = d.keys
ReDim s(1 To d.Count, 1 To 1)
For i = UBound(t) To 0 Step -1
k1 = k1 + 1
s(k1, 1) = t(i)
Next
[f1] = "辅助姓名"
For m = 2 To d.Count + 1
Cells(m, 6) = s(m - 1, 1)
Next
For m = 2 To d.Count + 1
100:
k2 = Application.WorksheetFunction.CountIf(Columns("a"), Cells(m, 6))
If k2 = 1 Then
m = m + 1
GoTo 100
End If
k3 = Columns("a").Find(Cells(m, 6)).Row
For p = 1 To k2 - 1
If Cells(k3, 2) <> Cells(k3 + 1, 3) Then
Cells(k3, 2).Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Cells(k3 + 1, 3).Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
End If
k3 = k3 + 1
Next
Next
For m = 2 To d.Count + 1
400:
k4 = Application.WorksheetFunction.CountIf(Columns("a"), Cells(m, 6))
If k4 = 1 Then
m = m + 1
GoTo 400
End If
k5 = Columns("a").Find(Cells(m, 6)).Row
For p = 1 To k4 - 1
If Cells(k5, 4) <> Cells(k5 + 1, 5) Then
Cells(k5, 4).Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Cells(k5 + 1, 5).Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
End If
k5 = k5 + 1
Next
Next
Columns("F:F").Select
Selection.ClearContents
End Sub |
|