我在第一页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
请查看代码,并请帮助。非常感谢!
发布于 2017-02-02 15:00:26
详细说明上面的评论
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
发布于 2017-02-02 14:41:03
纳贝拉
我建议您切换到条件格式以完成此任务,而不是编写宏。
您可以添加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...]
发布于 2017-02-02 16:40:18
试试这个:
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
https://stackoverflow.com/questions/42004768
复制相似问题