根据另一个单元格数据更改单元格颜色,但如果数据再次更改则保持这种状态
Change cell color base on another cells data but keep it that way if data changes again
我已经找了好几天来解决这个问题,但只想出了一半的解决方案。
我能做什么:
我只想让一个单元格在内部变成绿色,并在另一个单元格数据中包含单词 "Complete" 时插入一个 x。
我不能做什么:
当单词 "Complete" 更改为 "Rework" 时,我希望那个变成绿色并插入 x 的单元格保持绿色并带有 x。
因此单元格 A1 为空白,然后在单元格 B1 中添加单词 "Complete"。然后单元格 A1 变为绿色并且其中有一个 x。如果稍后 B1 更改为 "Rework" 我希望 A1 保持绿色,其中的 x 位于其中。所以我可以知道有一段时间B1的状态是"Complete"
我一直在尝试使用规则进行条件格式设置,但无法保留它。我认为其中的 "Stop If True" 复选框将是解决方案的一部分,但不确定代码是什么。
我在这个 sheet 上已经有一个不同的宏 运行,所以如果答案是一个宏,我需要将它添加到其中。下面是 sheet 中的宏。谢谢。
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("N:N,Y:Y"), Range("10:" & Rows.Count)) Is Nothing Then
If Target.Count < Columns.Count Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim r As Range
For Each r In Intersect(Target, Range("N:N,Y:Y"), Range("10:" & Rows.Count))
With r.Offset(0, 1)
.Value = Now 'use Now to retain the time as well as the date
.NumberFormat = "mm/dd/yy" 'change to what you prefer
End With
Next r
End If
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
您需要两个工作表事件和一些 If
语句。以下内容应该可以帮助您入门,除非我忽略了什么。
Dim oldVal as String ' Public variable
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Debug.Print Target.Address
If Target.Cells.Count <> 1 Then Exit Sub
oldVal = Target.Value
End Sub
以上会记下oldValue
Private Sub Worksheet_Change(ByVal Target As Range)
Dim newVal As String
newVal = Target.Value
If newVal = oldVal Then
Debug.Print "Same Values"
ElseIf oldVal = "Complete" And newVal = "Rework" Then
Debug.Print "Stay green with X"
ElseIf oldVal = "" And (newVal = "Complete" Or newVal = "complete") Then
Debug.Print "Change cell to Green, add an 'X'"
Target.Interior.ColorIndex = 10
Target.Value = Target.Value & " x"
End If
End Sub
然后,add/tweak 那些必要的 If 语句,并将颜色 changing/reverting 代码添加到适当的块。
(当然可能有更好的捕鼠器,但我认为这应该能让你继续)。
理想情况下,您可以将其拆分为单独的 sub 来处理每种更改类型,但这应该会给您一个想法:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, r as Range
'skip full-row changes (row insert/delete?)
If Target.Columns.Count = Columns.Count Then Exit Sub
Set rng = Intersect(Target, Range("N:N,Y:Y"), Range("10:" & Rows.Count))
If Not rng Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
For Each r In rng.Cells
With r.Offset(0, 1)
.Value = Now 'use Now to retain the time as well as the date
.NumberFormat = "mm/dd/yy" 'change to what you prefer
End With
Next r
End If
Set rng = Intersect(Target, Range("B:B"), Range("10:" & Rows.Count))
If Not rng Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
For Each r In rng.Cells
If r.Value = "Complete" Then
With r.Offset(0, -1)
.Value = "x"
.Interior.Color = vbGreen
End With '<<EDIT thanks @BruceWayne
End If
Next r
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
我已经找了好几天来解决这个问题,但只想出了一半的解决方案。
我能做什么:
我只想让一个单元格在内部变成绿色,并在另一个单元格数据中包含单词 "Complete" 时插入一个 x。
我不能做什么:
当单词 "Complete" 更改为 "Rework" 时,我希望那个变成绿色并插入 x 的单元格保持绿色并带有 x。
因此单元格 A1 为空白,然后在单元格 B1 中添加单词 "Complete"。然后单元格 A1 变为绿色并且其中有一个 x。如果稍后 B1 更改为 "Rework" 我希望 A1 保持绿色,其中的 x 位于其中。所以我可以知道有一段时间B1的状态是"Complete"
我一直在尝试使用规则进行条件格式设置,但无法保留它。我认为其中的 "Stop If True" 复选框将是解决方案的一部分,但不确定代码是什么。
我在这个 sheet 上已经有一个不同的宏 运行,所以如果答案是一个宏,我需要将它添加到其中。下面是 sheet 中的宏。谢谢。
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("N:N,Y:Y"), Range("10:" & Rows.Count)) Is Nothing Then
If Target.Count < Columns.Count Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim r As Range
For Each r In Intersect(Target, Range("N:N,Y:Y"), Range("10:" & Rows.Count))
With r.Offset(0, 1)
.Value = Now 'use Now to retain the time as well as the date
.NumberFormat = "mm/dd/yy" 'change to what you prefer
End With
Next r
End If
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
您需要两个工作表事件和一些 If
语句。以下内容应该可以帮助您入门,除非我忽略了什么。
Dim oldVal as String ' Public variable
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Debug.Print Target.Address
If Target.Cells.Count <> 1 Then Exit Sub
oldVal = Target.Value
End Sub
以上会记下oldValue
Private Sub Worksheet_Change(ByVal Target As Range)
Dim newVal As String
newVal = Target.Value
If newVal = oldVal Then
Debug.Print "Same Values"
ElseIf oldVal = "Complete" And newVal = "Rework" Then
Debug.Print "Stay green with X"
ElseIf oldVal = "" And (newVal = "Complete" Or newVal = "complete") Then
Debug.Print "Change cell to Green, add an 'X'"
Target.Interior.ColorIndex = 10
Target.Value = Target.Value & " x"
End If
End Sub
然后,add/tweak 那些必要的 If 语句,并将颜色 changing/reverting 代码添加到适当的块。
(当然可能有更好的捕鼠器,但我认为这应该能让你继续)。
理想情况下,您可以将其拆分为单独的 sub 来处理每种更改类型,但这应该会给您一个想法:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, r as Range
'skip full-row changes (row insert/delete?)
If Target.Columns.Count = Columns.Count Then Exit Sub
Set rng = Intersect(Target, Range("N:N,Y:Y"), Range("10:" & Rows.Count))
If Not rng Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
For Each r In rng.Cells
With r.Offset(0, 1)
.Value = Now 'use Now to retain the time as well as the date
.NumberFormat = "mm/dd/yy" 'change to what you prefer
End With
Next r
End If
Set rng = Intersect(Target, Range("B:B"), Range("10:" & Rows.Count))
If Not rng Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
For Each r In rng.Cells
If r.Value = "Complete" Then
With r.Offset(0, -1)
.Value = "x"
.Interior.Color = vbGreen
End With '<<EDIT thanks @BruceWayne
End If
Next r
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub