VBA按照下拉列表值对整个列进行颜色编码

我有Sheet 1 VBA窗口中的代码。 工作簿中的Excel工作表1与列C中的下拉列表一致。下拉列表中的4个选项是：完成，待定，错过截止date和可行。 下拉列表使用表2制定并定义名称方法。 但是，当我select例如“完整”的值时，整行的颜色不会变成绿色。 我哪里错了？

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，

我build议你切换到条件格式来完成这个任务，而不是写一个macros。

您可以添加4种样式，每种颜色一种，并select基于公式的条件，并添加公式（考虑N是具有状态的列，5是表格的第一行 ，replace为您的值）：

 = $N5="Workable" 

如果你需要OR条件，你可以使用

 = (($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