iT邦幫忙

0

Excel VBA 依條件儲存格反色

https://ithelp.ithome.com.tw/upload/images/20181116/20109231JnRA4msWOk.png

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

  1. B2:V2欄,名稱為 "目標" 該欄反淺藍色+粗體。
  2. B2:V2欄,名稱為 "達成" 該欄反深藍色+粗體。
  3. D3:D20列,名稱為 "All" 該列反淺灰色+粗體。
  4. C3:C20列,名稱為 "All" 該列反灰色+粗體。
  5. B3:B20列,名稱為 "All" 該列反深灰色+粗體。

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

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

1 個回答

0
來杯拿鐵
iT邦新手 4 級 ‧ 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
看更多先前的回應...收起先前的回應...

https://ithelp.ithome.com.tw/upload/images/20181120/201092314AwQ3yw0gk.png

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

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

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

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

https://ithelp.ithome.com.tw/upload/images/20181121/20091910DnYKtXkKz8.jpg
註:End(xlDown)=鍵盤(Shift+ctrl+下)

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

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

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

了解

填滿整列顏色,因為表格第二列有空值,故用試算表找尾欄。
不確定你的版本,所以假設表格不超過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

來大~~實在太感謝你了!!!
問題已成功解決
再次感謝!!!

我要發表回答

立即登入回答