返回列表 上一主題 發帖

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

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
1# 跳轉到 »
發表於 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

lpk187

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

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

lpk187

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

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

        靜思自在 : 屋寬不如心寬。
返回列表 上一主題