返回列表 上一主題 發帖

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

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

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

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

Color.zip (6.79 KB)
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

回復 1# david1216jp

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

  2. '當C欄中的內容改變時(單一儲存格)
  3. Private Sub Worksheet_Change(ByVal Target As Range)
  4.     If Target.Count = 1 Then
  5.         If Target.Row > 1 And Target.Column = 3 Then
  6.             Select Case Target Mod 3 '求餘數
  7.                     Case 1 '當餘數為1時,Rng所在行的A到D欄為'淺黃(後面依此類推)
  8.                         Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Interior.Color = 13434879 '淺黃
  9.                     Case 2
  10.                         Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Interior.Color = 13434828 '淺綠
  11.                     Case 0
  12.                         Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Interior.Color = 16777164 '天藍
  13.             End Select
  14.         End If
  15.     End If
  16. End Sub

  17. '批次變更
  18. Sub Ex()
  19. Dim Rng As Range
  20.     With Sheets("Color")
  21.         Set Rng = .Cells(2, 3)
  22.         Do While Rng <> ""
  23.             Select Case Rng Mod 3 '求餘數
  24.                 Case 1 '當餘數為1時,Rng所在行的A到D欄為'淺黃(後面依此類推)
  25.                     .Range(.Cells(Rng.Row, 1), .Cells(Rng.Row, 4)).Interior.Color = 13434879 '淺黃
  26.                 Case 2
  27.                     .Range(.Cells(Rng.Row, 1), .Cells(Rng.Row, 4)).Interior.Color = 13434828 '淺綠
  28.                 Case 0
  29.                     .Range(.Cells(Rng.Row, 1), .Cells(Rng.Row, 4)).Interior.Color = 16777164 '天藍
  30.             End Select
  31.             Set Rng = Rng.Offset(1) '移到下一儲存格
  32.         Loop
  33.         Rng.Select
  34.     End With
  35. End Sub
複製代碼

TOP

http://blog.xuite.net/hcm19522/twblog/509695526
3233.png
隨意窩 "EXCEL迷"  blog  或 http://blog.xuite.net/hcm19522/twblog
已收集3600篇 EXCEL函數
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

感謝前輩幫忙,我剛剛測試可以達到我要的目的,
真的非常感謝幫忙,再次謝謝前輩!!
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

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

  3. ColorArr = Array("", "13434879", "13434879", "13434879", "13434828", "13434828", "13434828", "16777164", "16777164", "16777164") '定義從0~9的顏色
  4. I = 2   '起始列
  5. With ActiveSheet
  6.     Do While .Cells(I, 4) <> ""
  7.         .Range(.Cells(I, 1), .Cells(I, 4)).Interior.Color = ColorArr(.Cells(I, 4))
  8.         I = I + 1
  9.     Loop
  10. End With
  11. End Sub
複製代碼
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

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

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

  2. '當C欄中的內容改變時(範圍)
  3. Private Sub Worksheet_Change(ByVal Target As Range)
  4.     Dim tar As Range
  5.     For Each tar In Target
  6.         If tar.Value <> "" Then
  7.             If tar.Row > 1 And tar.Column = 3 Then
  8.                 Range(Cells(tar.Row, 1), Cells(tar.Row, 4)). _
  9.                 Interior.Color = GetColor(tar.Value)
  10.             End If
  11.         Else
  12.         Range(Cells(tar.Row, 1), Cells(tar.Row, 4)). _
  13.                 Interior.Pattern = xlNone
  14.         End If
  15.     Next
  16. End Sub

  17. '批次變更
  18. Sub Ex()
  19. Dim Rng As Range
  20. Dim sh As Worksheet
  21.     Set sh = Sheets("Color")
  22.     With sh
  23.         Set Rng = .Cells(2, 3)
  24.         Do While Rng <> ""
  25.             .Range(.Cells(Rng.Row, 1), .Cells(Rng.Row, 4)). _
  26.             Interior.Color = GetColor(Rng.Value)
  27.             Set Rng = Rng.Offset(1) '移到下一儲存格
  28.         Loop
  29.         Rng.Select
  30.     End With
  31. End Sub

  32. Public Function GetColor(n As Integer) '依據 n 值來獲得色碼
  33.     Select Case n Mod 3
  34.         Case 1
  35.            GetColor = 13434879 '淺黃
  36.         Case 2
  37.            GetColor = 13434828 '淺綠
  38.         Case 0
  39.            GetColor = 16777164 '天藍
  40.         
  41.     End Select
  42. End Function
複製代碼
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

回復 5# prin.huang


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

  3. ColorArr = Array("13434879", "13434828", "16777164") '定義從0~9的顏色
  4. I = 2   '起始列
  5. With ActiveSheet
  6.     Do While .Cells(I, 3) <> ""
  7.         .Range(.Cells(I, 1), .Cells(I, 4)).Interior.Color = ColorArr(.Cells(I, 3) Mod 3)
  8.         I = I + 1
  9.     Loop
  10. End With
  11. End Sub
複製代碼
是不是清析多了
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

感謝前輩們提供方法,讓我學到很多,再次感謝前輩們。
也謝謝這論壇讓大家有互相交流的機會,我很感激前輩們的教導!!
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

回復 6# lpk187
確實,用function來維護,會較不易出錯
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

回復 1# david1216jp


    條件不多用格式化條件玩玩
未命名.png
2017-6-15 10:44
學海無涯_不恥下問

TOP

        靜思自在 : 虛空有盡.我願無窮,發願容易行願難。
返回列表 上一主題