|
- Sub test()
- Dim sh As Worksheet, d As Object, ar, n&, i&, kk, rng As Range
- Set d = CreateObject("Scripting.Dictionary")
- For Each sh In Sheets
- n = sh.Range("C" & Rows.Count).End(xlUp).Row
- ar = sh.Range("C2:C" & n)
- sh.Cells.Interior.Color = 15138815
- For i = 1 To UBound(ar)
- If d.exists(ar(i, 1)) Then
- d(ar(i, 1)) = d(ar(i, 1)) + 1
- Else
- d(ar(i, 1)) = 1
- End If
- Next
- Next
- For Each kk In d.keys
- If d(kk) = 1 Then d.Remove (kk)
- Next
- For Each sh In Sheets
- n = sh.Range("C" & Rows.Count).End(xlUp).Row
- ar = sh.Range("C1:C" & n)
- For i = 2 To UBound(ar)
- If d.exists(ar(i, 1)) Then
- If rng Is Nothing Then
- Set rng = sh.Range("C" & i)
- Else
- Set rng = Union(rng, sh.Range("C" & i))
- End If
- If rng.Count > 255 Then rng.Interior.Color = vbYellow: Set rng = Nothing
- End If
- Next
- If rng.Count > 0 Then rng.Interior.Color = vbYellow: Set rng = Nothing
- Next
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|