返回列表 上一主題 發帖

[發問] (已解決)如何同一區塊相同資料標顏色

回復 1# freeffly

A欄必須要排序
  1. Sub xx()
  2. Dim d As Object
  3. Dim Rng As Range
  4. Columns("A").Interior.ColorIndex = 0
  5. Set d = CreateObject("Scripting.Dictionary")
  6. For Each A In Range("A2:A" & [A65536].End(xlUp).Row)
  7.   d(A.Value) = A.Value
  8. Next
  9. Ar = d.Items
  10. For Each A In Range("A2:A" & [A65536].End(xlUp).Row)
  11.   For R = 0 To d.Count Step 2
  12.     If A = Ar(R) Then
  13.       If Rng Is Nothing Then
  14.         Set Rng = A
  15.       Else
  16.         Set Rng = Union(Rng, A)
  17.       End If
  18.     End If
  19.   Next R
  20. Next
  21. Rng.Interior.ColorIndex = 6
  22. End Sub
複製代碼

TOP

回復 4# freeffly
不是列數限制
之前程式稍作修正
  1. Sub xx()
  2. Dim d As Object
  3. Dim Rng As Range
  4. Dim Ar
  5. Columns("A").Interior.ColorIndex = 0
  6. Set d = CreateObject("Scripting.Dictionary")
  7. For Each A In Range("A2:A" & [A65536].End(xlUp).Row)
  8.   d(A.Value) = A.Value
  9. Next
  10. Ar = d.Items
  11. For Each A In Range("A2:A" & [A65536].End(xlUp).Row)
  12.   For R = 1 To d.Count - 1 Step 2
  13.       If A = Ar(R) Then
  14.       If Rng Is Nothing Then
  15.         Set Rng = A
  16.       Else
  17.         Set Rng = Union(Rng, A)
  18.       End If
  19.     End If
  20.   Next R
  21. Next
  22. Rng.Interior.ColorIndex = 6
  23. End Sub
複製代碼

TOP

回復 6# freeffly

說明詳見檔案
Test.rar (13.89 KB)

TOP

        靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言,就如鑽石般珍貴;但對愚人來說,卻像是一把泥土,一點價值也沒有。
返回列表 上一主題