返回列表 上一主題 發帖

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

david1216jp

帖子
12 
主題
5 
精華
0 
積分
67 
點名
0  
作業系統
windows 10 
軟體版本
office 365 
閱讀權限
20 
性別
男 
註冊時間
2017-3-27 
最後登錄
2021-7-4 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2017-5-30 07:31 | 只看該作者

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

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

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

Color.zip (6.79 KB)
收藏 分享

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
10#
發表於 2017-6-15 10:44 | 只看該作者
回復 1# david1216jp


    條件不多用格式化條件玩玩
學海無涯_不恥下問

TOP

prin.huang

帖子
44 
主題
4 
精華
0 
積分
84 
點名
0  
作業系統
winxp 
軟體版本
sp2 
閱讀權限
20 
性別
男 
註冊時間
2016-10-12 
最後登錄
2021-11-10 
9#
發表於 2017-5-31 21:03 | 只看該作者
回復 6# lpk187
確實，用function來維護，會較不易出錯

TOP

david1216jp

帖子
12 
主題
5 
精華
0 
積分
67 
點名
0  
作業系統
windows 10 
軟體版本
office 365 
閱讀權限
20 
性別
男 
註冊時間
2017-3-27 
最後登錄
2021-7-4 
8#
發表於 2017-5-31 19:51 | 只看該作者
感謝前輩們提供方法，讓我學到很多，再次感謝前輩們。
也謝謝這論壇讓大家有互相交流的機會，我很感激前輩們的教導!!

TOP

lpk187

帖子
552 
主題
6 
精華
0 
積分
576 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2026-9-10 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
7#
發表於 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
複製代碼
是不是清析多了

TOP

lpk187

帖子
552 
主題
6 
精華
0 
積分
576 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2026-9-10 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
6#
發表於 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
複製代碼

TOP

prin.huang

帖子
44 
主題
4 
精華
0 
積分
84 
點名
0  
作業系統
winxp 
軟體版本
sp2 
閱讀權限
20 
性別
男 
註冊時間
2016-10-12 
最後登錄
2021-11-10 
5#
發表於 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
複製代碼

TOP

david1216jp

帖子
12 
主題
5 
精華
0 
積分
67 
點名
0  
作業系統
windows 10 
軟體版本
office 365 
閱讀權限
20 
性別
男 
註冊時間
2017-3-27 
最後登錄
2021-7-4 
4#
發表於 2017-5-30 15:33 | 只看該作者
感謝前輩幫忙，我剛剛測試可以達到我要的目的，
真的非常感謝幫忙，再次謝謝前輩!!

TOP

hcm19522

帖子
1814 
主題
193 
精華
0 
積分
2012 
點名
0  
作業系統
WIN 
軟體版本
2007 
閱讀權限
100 
性別
男 
註冊時間
2015-9-11 
最後登錄
2026-10-30 

熱烈參與勳章
3#
發表於 2017-5-30 13:56 | 只看該作者
http://blog.xuite.net/hcm19522/twblog/509695526

3233.png (12.77 KB)

3233.png

google"EXCEL迷"  blog  或google網址:https://hcm19522.blogspot.com/

TOP

lpk187

帖子
552 
主題
6 
精華
0 
積分
576 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2026-9-10 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
2#
發表於 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
複製代碼

TOP

        靜思自在 : 【為善競爭】人生要為善競爭，分秒必爭。
返回列表 上一主題