根据另一个单元格数据更改单元格颜色,但如果数据再次更改则保持这种状态

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