[發問] 請教上顏色問題，感謝!! 顏色

david1216jp

您好，請問一下各位前輩，
我想詢問如何讓整列的顏色~依據C欄的日期上顏色轉化為vba的寫法，
即黃(日期1)→綠(日期2)→藍(日期3)→黃(日期4)→綠(日期5)→藍(日期6)→黃(日期7)→綠(日期8)→藍(日期9).....
還請前輩幫忙，非常感謝!!

下載 (72.69 KB)

2017-5-30 07:24

Color.zip (6.79 KB)

下載次數: 15

2017-5-30 07:32

Hsieh

回復 1# david1216jp


    條件不多用格式化條件玩玩

下載 (27.63 KB)

2017-6-15 10:44

prin.huang

回復 6# lpk187
確實，用function來維護，會較不易出錯

david1216jp

感謝前輩們提供方法，讓我學到很多，再次感謝前輩們。
也謝謝這論壇讓大家有互相交流的機會，我很感激前輩們的教導!!

lpk187

回復 5# prin.huang


    而你的代碼也可以修改成這樣

1. Sub GiveColor()
   
2. Dim ColorArr(), I%
   
3. 
   
4. ColorArr = Array("13434879", "13434828", "16777164") '定義從0~9的顏色
   
5. I = 2   '起始列
   
6. With ActiveSheet
   
7.     Do While .Cells(I, 3) <> ""
   
8.         .Range(.Cells(I, 1), .Cells(I, 4)).Interior.Color = ColorArr(.Cells(I, 3) Mod 3)
   
9.         I = I + 1
   
10.     Loop
    
11. End With
    
12. End Sub

複製代碼

是不是清析多了

lpk187

回復 5# prin.huang
不好意思，我並不是來吐槽的！
陣列不是好維護的，也不是最好定義的！陣列的速度是很快，但判斷也不見得慢多少`，寫代碼不見得快就是最好，而是日後容易維護，
可以重載(再使用)的代碼最好用函數去寫，
以日後維護來說，依你的方法你會改死的，並不建議你如此使用，就像依本篇樓主的問題來說好了，樓主是依據"日"的不同來變更行的色彩
若依如此你是不是要定義31個陣列的值？(陣列的值輸入，最好是讀取範圍或自動產生，可以的話最好不要打字！！)
31個還好，那300個、3000個甚至30000個呢？那時的維護是哪個容易？而且程式碼也會很冗長的。
其實日後要程式碼好維護或容易更改，最好的方式是寫函數(方法)替代。
以我原來寫的原代碼來說，其實若是多一個函數(方法)的話，那定義色彩是不是就容易多了，日後增減也容易，只要修改函數即可
修改後代碼如下：

1. Option Explicit
   
2. 
   
3. '當C欄中的內容改變時(範圍)
   
4. Private Sub Worksheet_Change(ByVal Target As Range)
   
5.     Dim tar As Range
   
6.     For Each tar In Target
   
7.         If tar.Value <> "" Then
   
8.             If tar.Row > 1 And tar.Column = 3 Then
   
9.                 Range(Cells(tar.Row, 1), Cells(tar.Row, 4)). _
   
10.                 Interior.Color = GetColor(tar.Value)
    
11.             End If
    
12.         Else
    
13.         Range(Cells(tar.Row, 1), Cells(tar.Row, 4)). _
    
14.                 Interior.Pattern = xlNone
    
15.         End If
    
16.     Next
    
17. End Sub
    
18. 
    
19. '批次變更
    
20. Sub Ex()
    
21. Dim Rng As Range
    
22. Dim sh As Worksheet
    
23.     Set sh = Sheets("Color")
    
24.     With sh
    
25.         Set Rng = .Cells(2, 3)
    
26.         Do While Rng <> ""
    
27.             .Range(.Cells(Rng.Row, 1), .Cells(Rng.Row, 4)). _
    
28.             Interior.Color = GetColor(Rng.Value)
    
29.             Set Rng = Rng.Offset(1) '移到下一儲存格
    
30.         Loop
    
31.         Rng.Select
    
32.     End With
    
33. End Sub
    
34. 
    
35. Public Function GetColor(n As Integer) '依據 n 值來獲得色碼
    
36.     Select Case n Mod 3
    
37.         Case 1
    
38.            GetColor = 13434879 '淺黃
    
39.         Case 2
    
40.            GetColor = 13434828 '淺綠
    
41.         Case 0
    
42.            GetColor = 16777164 '天藍
    
43.         
    
44.     End Select
    
45. End Function

複製代碼

prin.huang

考量往後可能會想定義不同顏色，建議用陣列，修改時不必改一堆判斷式

1. Sub GiveColor()
   
2. Dim ColorArr(), I%
   
3. 
   
4. ColorArr = Array("", "13434879", "13434879", "13434879", "13434828", "13434828", "13434828", "16777164", "16777164", "16777164") '定義從0~9的顏色
   
5. I = 2   '起始列
   
6. With ActiveSheet
   
7.     Do While .Cells(I, 4) <> ""
   
8.         .Range(.Cells(I, 1), .Cells(I, 4)).Interior.Color = ColorArr(.Cells(I, 4))
   
9.         I = I + 1
   
10.     Loop
    
11. End With
    
12. End Sub

複製代碼

david1216jp

感謝前輩幫忙，我剛剛測試可以達到我要的目的，
真的非常感謝幫忙，再次謝謝前輩!!

hcm19522

http://blog.xuite.net/hcm19522/twblog/509695526

lpk187

回復 1# david1216jp

2個方式，當C欄中的內容改變時(單一儲存格)和批次變更

1. Option Explicit
   
2. 
   
3. '當C欄中的內容改變時(單一儲存格)
   
4. Private Sub Worksheet_Change(ByVal Target As Range)
   
5.     If Target.Count = 1 Then
   
6.         If Target.Row > 1 And Target.Column = 3 Then
   
7.             Select Case Target Mod 3 '求餘數
   
8.                     Case 1 '當餘數為1時，Rng所在行的A到D欄為'淺黃(後面依此類推)
   
9.                         Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Interior.Color = 13434879 '淺黃
   
10.                     Case 2
    
11.                         Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Interior.Color = 13434828 '淺綠
    
12.                     Case 0
    
13.                         Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Interior.Color = 16777164 '天藍
    
14.             End Select
    
15.         End If
    
16.     End If
    
17. End Sub
    
18. 
    
19. '批次變更
    
20. Sub Ex()
    
21. Dim Rng As Range
    
22.     With Sheets("Color")
    
23.         Set Rng = .Cells(2, 3)
    
24.         Do While Rng <> ""
    
25.             Select Case Rng Mod 3 '求餘數
    
26.                 Case 1 '當餘數為1時，Rng所在行的A到D欄為'淺黃(後面依此類推)
    
27.                     .Range(.Cells(Rng.Row, 1), .Cells(Rng.Row, 4)).Interior.Color = 13434879 '淺黃
    
28.                 Case 2
    
29.                     .Range(.Cells(Rng.Row, 1), .Cells(Rng.Row, 4)).Interior.Color = 13434828 '淺綠
    
30.                 Case 0
    
31.                     .Range(.Cells(Rng.Row, 1), .Cells(Rng.Row, 4)).Interior.Color = 16777164 '天藍
    
32.             End Select
    
33.             Set Rng = Rng.Offset(1) '移到下一儲存格
    
34.         Loop
    
35.         Rng.Select
    
36.     End With
    
37. End Sub

複製代碼