Board logo

標題: [發問] (已解決)如何同一區塊相同資料標顏色 [打印本頁]
作者: freeffly    時間: 2012-5-11 09:36     標題: (已解決)如何同一區塊相同資料標顏色

本帖最後由 freeffly 於 2012-5-11 13:13 編輯

以前在一般區問過同樣問題
如何同一區塊相同資料標顏色
不過資料多的時候會發生excel當掉的感覺
不知道是不是持續運算的關係
如果改成用vba要如何寫?
A欄要做像D欄那樣的效果

[attach]10900[/attach]
作者: register313    時間: 2012-5-11 12:18

回復 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
複製代碼
作者: freeffly    時間: 2012-5-11 13:12

回復 2# register313


    謝謝
   字典的對我來說還很難
   感覺比文言文還難
作者: freeffly    時間: 2012-5-21 11:57

回復 2# register313

    大大
    剛剛發現會有列數限制
   這各有辦法克服嗎
   太多好像會出現陣列超出範圍的問題









[attach]11077[/attach]
作者: register313    時間: 2012-5-21 13:13

回復 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
複製代碼
作者: freeffly    時間: 2012-5-21 13:38

回復 5# register313


    大大請問第12行代碼的意思

   如果用原代碼 後面加-1也可行
  1. For R = 0 To d.Count - 1 Step 2
複製代碼
或是原代碼1改為0也行
  1. For R = 1 To d.Count  Step 2
複製代碼
大大新的代碼是這各 還有Dim Ar
  1. For R = 1 To d.Count - 1 Step 2
複製代碼
作了之後標顏色區塊有點不一樣 可是會同樣效果
   也不會出現陣列超出範圍
   為什麼會有差異?
作者: register313    時間: 2012-5-21 15:24

回復 6# freeffly

說明詳見檔案
[attach]11083[/attach]
作者: freeffly    時間: 2012-5-21 15:43

回復 7# register313


    謝謝大大
   for to step 這各之前沒用過
   看到附件才知道是count的數量是偶數或單數造成
   學習了
作者: Andy2483    時間: 2023-4-10 15:47

回復 1# freeffly


    謝謝論壇,謝謝前輩發表此主題與範例
後學藉此帖練習陣列與字典,學習方案如下,請前輩參考,請各位前輩指教

執行前:
[attach]36108[/attach]

執行結果:
[attach]36109[/attach]


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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)