Question

我在Sheet 1 VBA窗口中有代码。工作簿中的Excel工作表1带有C列中的下拉列表。下拉列表中的4个选项包括：完成，待定，错过截止日期和可工作。下拉列表使用工作表2并定义名称方法。但是，当我选择值例如＆＃34;完成＆＃34;时，整行的颜色不会变为绿色。我哪里错了？

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

Nabeela，

我建议您切换到条件格式来完成此任务，而不是编写宏。

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

= $N5="Workable"

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

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

如果您需要AND条件，请使用

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

详细说明上述评论

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 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

VBA根据下拉列表值对整列进行颜色编码

3 个答案: