VBA根據下拉列表值對整個列進行顏色編碼

Question

我有Sheet 1 VBA窗口中的代碼。工作簿中的Excel工作表1與列C中的下拉列表一致。下拉列表中的4個選項爲：完成，待定，錯過截止日期和可行。下拉列表使用表2制定並定義名稱方法。但是，當我選擇值例如「完整」時，整行的顏色不會變成綠色。我哪裏錯了？

Private Sub Worksheet_Change(ByVal Target As Range) 

'to make entire row green when job is workable 
If Selection.Text = "Workable" Then 
With ActiveCell 
Range(Cells(.Row, .CurrentRegion.Column), Cells(.Row, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)).Select 
     With Selection.Interior 
     .Pattern = xlSolid 
     .PatternColorIndex = xlAutomatic 
     .Color = 5287936 
     .TintAndShade = 0 
     .PatternTintAndShade = 0 

    End With 
    End With 

' to make entire row yellow when pending additonal information 

ElseIf Selection.Text = "Pending" Then 
With ActiveCell 
Range(Cells(.Row, .CurrentRegion.Column), Cells(.Row, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)).Select 

    With Selection.Interior 
     .Pattern = xlSolid 
     .PatternColorIndex = xlAutomatic 
     .Color = 65535 
     .TintAndShade = 0 
     .PatternTintAndShade = 0 

    End With 
    End With 
'to make entire row red when job is not workable 

ElseIf Selection.Text = "Missed Deadline" Then 
With ActiveCell 
Range(Cells(.Row, .CurrentRegion.Column), Cells(.Row, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)).Select 
With Selection.Interior 
     .Pattern = xlSolid 
     .PatternColorIndex = xlAutomatic 
     .Color = 255 
     .TintAndShade = 0 
     .PatternTintAndShade = 0 
End With 
End With 


'to make entire row light blue when job is complete 

ElseIf Selection.Text = "Complete" Then 
With ActiveCell 
Range(Cells(.Row, .CurrentRegion.Column), Cells(.Row, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)).Select 
With Selection.Interior 
     .Pattern = xlSolid 
     .PatternColorIndex = xlAutomatic 
     .ThemeColor = xlThemeColorAccent1 
     .TintAndShade = 0.799981688894314 
     .PatternTintAndShade = 0 

End With 
End With 

MsgBox "AWESOME!YOU DID IT!" 

End If 


End Sub 

請參閱代碼和幫助。非常感謝！

Answer 1

要在評論闡述上述

Private Sub Worksheet_Change(ByVal Target As Range) 

'to make entire row green when job is workable 
If Target.Text = "Workable" Then 
    With Target.EntireRow 
     With .Interior 
      .Pattern = xlSolid 
      .PatternColorIndex = xlAutomatic 
      .Color = 5287936 
      .TintAndShade = 0 
      .PatternTintAndShade = 0 
     End With 
    End With 

    'etc 

Answer 2

Nabeela，

我會建議你切換到條件格式來完成這個任務，而不是寫一個宏。

您可以添加4個款式，每一種顏色，然後選擇基於公式的條件，並添加公式（考慮N是與狀態和5列是表的第一排，替換爲您值）：

= $N5="Workable" 

若您需要或者條件可以使用

= (($N5="Workable")+($N5="SomethingElse")>0) 

如果你需要和條件，使用

= ($N5="Workable")*($N5="SomethingElse") 

然後將樣式應用於整個表格。

。

考慮您的評論，看看這個部分：

With ActiveCell 
    Range(Cells(.[........] 

我會改變這

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim rng as Excel.Range 
'[...] - your code here 
With ActiveCell 
Set rng = ActiveSheet.Range(_ 
    Cells(.Row, .CurrentRegion.Column), _ 
    Cells(.Row, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)) 
With rng.Interior 
    .Pattern = xlSolid 
    .PatternColorIndex = xlAutomatic 
    .Color = 5287936 
    .TintAndShade = 0 
    .PatternTintAndShade = 0 
End With 
'[...and so on...] 

Answer 3

試試這個：

Private Sub Worksheet_Change(ByVal Target As Range) 

Dim mClr As Long 
If Target.Column <> 3 Or Target.Count > 1 Then Exit Sub 

    Select Case Target.Value 
     Case "Workable": mClr = 5287936 
     Case "Pending": mClr = 65535 
     Case "Missed Deadline": mClr = 255 
     Case "Complete": mClr = 16247773 
     Case Else: Exit Sub 
    End Select 

    With Target.EntireRow.Interior 
     .Pattern = xlSolid 
     .PatternColorIndex = xlAutomatic 
     .Color = mClr 
     .TintAndShade = 0 
     .PatternTintAndShade = 0 
    End With 
End Sub 

爲了使上述代碼的工作，如果多於一個的小區（通過複製和粘貼例如）在同一時間改變，且對色復位到xlNone（白色），如果單元格的值是不在列表中：

Private Sub Worksheet_Change(ByVal Target As Range) 

Dim mClr As Long, Rng As Range, Cel As Range 
Set Rng = Application.Intersect(Target, Columns(3)) 

If Not Rng Is Nothing Then 
    For Each Cel In Rng 
     Select Case Cel.Value 
      Case "Workable": mClr = 5287936 
      Case "Pending": mClr = 65535 
      Case "Missed Deadline": mClr = 255 
      Case "Complete": mClr = 16247773 
      Case Else: mClr = xlNone 
     End Select 

     With Cel.EntireRow.Interior 
      .Pattern = xlSolid 
      .PatternColorIndex = xlAutomatic 
      .Color = mClr 
      .TintAndShade = 0 
      .PatternTintAndShade = 0 
     End With 
    Next 
End If 
End Sub