Option Explicit
Sub TEST()
Dim Brr, Y, i&, T$
Dim xR As Range, xU As Range
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([A2], Cells(Rows.Count, "A").End(3)): Brr = xR
Set xU = [A1]
For i = 1 To UBound(Brr)
T = Brr(i, 1)
If Y(T) = "" Then Y(T) = Y.Count
If Y(T) Mod 2 = 0 Then Set xU = Union(xU, Cells(i + 1, 1))
Next
[A:A].Interior.ColorIndex = xlNone
xU.Interior.ColorIndex = 6
Set Y = Nothing: Set xR = Nothing: Erase Brr
End Sub
發表於 2023-4-10 15:47
| 
