Board logo

標題: [發問] 請教上顏色問題，感謝!! [打印本頁]
作者: david1216jp    時間: 2017-5-30 07:31     標題: 請教上顏色問題，感謝!!

本帖最後由 david1216jp 於 2017-5-30 07:32 編輯

您好，請問一下各位前輩，
我想詢問如何讓整列的顏色~依據C欄的日期上顏色轉化為vba的寫法，
即黃(日期1)→綠(日期2)→藍(日期3)→黃(日期4)→綠(日期5)→藍(日期6)→黃(日期7)→綠(日期8)→藍(日期9).....
還請前輩幫忙，非常感謝!!
[attach]27246[/attach]
[attach]27247[/attach]
作者: lpk187    時間: 2017-5-30 12:28

回復 1# david1216jp

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

  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

  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
複製代碼
作者: hcm19522    時間: 2017-5-30 13:56

http://blog.xuite.net/hcm19522/twblog/509695526
作者: david1216jp    時間: 2017-5-30 15:33

感謝前輩幫忙，我剛剛測試可以達到我要的目的，
真的非常感謝幫忙，再次謝謝前輩!!
作者: prin.huang    時間: 2017-5-31 10:52

考量往後可能會想定義不同顏色，建議用陣列，修改時不必改一堆判斷式
  1. Sub GiveColor()
  2. Dim ColorArr(), I%

  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
複製代碼
作者: lpk187    時間: 2017-5-31 17:37

本帖最後由 lpk187 於 2017-5-31 17:39 編輯

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

  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

  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

  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
複製代碼
作者: lpk187    時間: 2017-5-31 17:42

回復 5# prin.huang


    而你的代碼也可以修改成這樣
  1. Sub GiveColor()
  2. Dim ColorArr(), I%

  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
複製代碼
是不是清析多了
作者: david1216jp    時間: 2017-5-31 19:51

感謝前輩們提供方法，讓我學到很多，再次感謝前輩們。
也謝謝這論壇讓大家有互相交流的機會，我很感激前輩們的教導!!
作者: prin.huang    時間: 2017-5-31 21:03

回復 6# lpk187
確實，用function來維護，會較不易出錯
作者: Hsieh    時間: 2017-6-15 10:44

回復 1# david1216jp


    條件不多用格式化條件玩玩
[attach]27337[/attach]



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