Excel VBA 依條件儲存格反色

excel vba

msmplayv121068 2018-11-16 23:13:40 ‧ 16650 瀏覽

分享至

請問如何使用VBA(非格式化條件)，讓範圍B2:V20可依條件欄及列反底色+粗體，條件如下:

B2:V2欄，名稱為 "目標" 該欄反淺藍色+粗體。
B2:V2欄，名稱為 "達成" 該欄反深藍色+粗體。
D3:D20列，名稱為 "All" 該列反淺灰色+粗體。
C3:C20列，名稱為 "All" 該列反灰色+粗體。
B3:B20列，名稱為 "All" 該列反深灰色+粗體。

提醒：設定條件需由1~5依序反色，如此才能依需求覆蓋其他底色。

測試檔https://drive.google.com/file/d/1iwqU0gEUAywjFtgxYDuURwzm1QcZCc7A/view?usp=sharing

登入發表討論

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

1 個回答

來杯拿鐵

iT邦新手 2 級 ‧ 2018-11-20 00:27:24

最佳解答

測試檔下載後，顯示有惡意程式。
不太確定原po的該欄跟該列是否為浮動，假設B欄都有字。
該欄只填色到與B欄同列

參考：[Excel VBA If cell.Value- Stack Overflow]（https://stackoverflow.com/questions/29006416/excel-vba-if-cell-value-then）
剩下的改參數就可以，只是該列的尾欄不確定到哪？

Sub ifcolor()
' ifcolor 巨集
'lacol 為B欄最後一個有值儲存格

Dim lacol As Integer
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.End(xlDown).Select
lacol = Selection.Row

'判斷第2列儲存格是否"達成"，該儲存格往下到lacol同列，填滿顏色
Dim cell As Range
For Each cell In Range("B2", "V2")
    If cell.Value = "達成" Then
        cell.Interior.color = XlRgbColor.rgbLightBlue
        cell.Font.Bold = True
        cell.Copy
        Range(cell, Cells(lacol, cell.Column)).Select
        Selection.PasteSpecial xlFormats
    End If
Next cell

回應 9
分享
檢舉

看更多先前的回應...收起先前的回應...

msmplayv121068 iT邦新手 4 級 ‧ 2018-11-20 22:49:03 檢舉

來大~~請問一下為什麼執行結果會只有醬呢？

msmplayv121068 iT邦新手 4 級 ‧ 2018-11-20 22:52:33 檢舉

另外已重新更新測試檔連結，非常感謝~~~

來杯拿鐵 iT邦新手 2 級 ‧ 2018-11-21 13:05:38 檢舉

沒注意到B2沒有資料，所以End(xlDown)只有有停留在B3。

Range("B2").Select'邏輯錯誤，B2更正為B3
Range(Selection, Selection.End(xlDown)).Select

註：End(xlDown)=鍵盤(Shift+ctrl+下)

msmplayv121068 iT邦新手 4 級 ‧ 2018-11-21 13:30:49 檢舉

來大，超級感謝的!!!測試已成功喔!!
另列的部份最後一欄第一列一定有字沒錯，真的超感謝你的幫忙

來杯拿鐵 iT邦新手 2 級 ‧ 2018-11-21 13:39:28 檢舉

了解，等我半小時。
每個人對於顏色定義會有差異，希望能給色票
http://dmcritchie.mvps.org/excel/colors.htm

msmplayv121068 iT邦新手 4 級 ‧ 2018-11-21 13:59:02 檢舉

來大，是也沒有那麼趕啦!!哈~~~~
然後顏色只是測試用，所以隨意用色就好，再次感謝你喔~~~~

來杯拿鐵 iT邦新手 2 級 ‧ 2018-11-21 14:33:43 檢舉

了解

來杯拿鐵 iT邦新手 2 級 ‧ 2018-11-21 16:14:56 檢舉

填滿整列顏色，因為表格第二列有空值，故用試算表找尾欄。
不確定你的版本，所以假設表格不超過1000欄。

Sub ifcolor()

'
'開頭宣告
    'ifst(需求1,2判斷字),colind(填滿顏色),rerg(需求3~5選取範圍)
Dim ifst, colind, rerg As Variant
Dim rei, sti As Integer
Dim cell, cell2 As Range
ifst = Array("目標", "達成")
colind = Array(3, 7, 8, 9, 10) '需求1~5依序填入色碼
rerg = Array("D3", "D20", "C3", "C20", "B3", "B20")

'lacol 為表格最尾列,larow 為表格最尾攔(第二列尾攔往左第一個字)
Dim lacol, larow As Integer
Range("B3").End(xlDown).Select
lacol = Selection.Row

Cells(2, 1000).End(xlToLeft).Select '日後欄出錯請改此參數
larow = Selection.Column

'主程式
    '整欄變色
        
    For sti = 0 To 1
        For Each cell In Range("B2", "V2")
            If cell.Value = ifst(sti) Then
                cell.Interior.ColorIndex = colind(sti)
                cell.Font.Bold = True
                cell.Copy
                Range(cell, Cells(lacol, cell.Column)).Select
                Selection.PasteSpecial xlFormats
            End If
        Next cell
    Next sti
    
    '整列變色
    
    For rei = 0 To 2
        For Each cell2 In Range(rerg(rei * 2), rerg(rei * 2 + 1))
            If cell2.Value = "All" Then
                cell2.Interior.ColorIndex = colind(rei + 2)
                cell2.Font.Bold = True
                cell2.Copy
                Range(cell2, Cells(cell2.Row, larow)).Select
                Selection.PasteSpecial xlFormats
            End If
        Next cell2
    Next rei

End Sub

顏色依序填即可
https://www.excel-pratique.com/en/vba/img_colors/colorindex.png