Question

我一直在寻找解决这个问题的日子，并且只提出了一半的解决方案。

我能做什么：

我只想让一个单元格内部变为绿色，当另一个单元格数据有单词＆＃34;完成＆＃34;在里面。

我不能做的事情：

我希望当单词＆＃34;完成＆＃34;时，同样的单元格会变成绿色并插入x。改为＆＃34;返工＆＃34;用x保持绿色。

因此，单元格A1为空白，然后在单元格B1中单词＆＃34;完成＆＃34;被添加。然后单元格A1变为绿色并且内部有一个x。如果以后B1改为＆＃34;返工＆＃34;我希望A1能够保持绿色x内部。所以我可以知道，B1的状态曾经是一次＆＃34;完成＆＃34;

我一直在尝试使用规则进行条件格式化但无法保留。我认为＆＃34;停止如果真的＆＃34;内部的复选框将是解决方案的一部分，但不确定代码是什么。

我已经在此工作表上运行了不同的宏，所以如果答案是宏，我将需要将其添加到它。下面是表格中的宏。谢谢。

    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

Answer 1

您需要两个工作表事件和一些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

然后，根据需要添加/调整那些If语句，并将颜色更改/还原代码添加到相应的块中。

（当然可能有一个更好的捕鼠器，但我认为这应该让你去。）

Answer 2

理想情况下，您可以将其拆分为单独的子组件来处理每种更改类型，但这应该会给您一个想法：

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

根据其他单元格数据更改单元格颜色，但如果数据再次更改，请保持这种方式

2 个答案: