删除excel值并将单元格设置为空

Question

我有以下 vba 代码完全按预期工作，除了一件事。

因此将其设置为跟踪工作表。工作表的目的是用 1 和 0 确定某事是否已完成，然后计算完成百分比...等等等等。

因此，当用户在工作表上（范围内）输入 1 时，它会将内部和字体颜色更改为绿色。如果用户输入 0，它会将内部和字体颜色更改为红色。

如果用户在一个一直为空的单元格上点击删除（从未有任何数据输入其中），则代码按预期工作。但是，如果用户在已输入数据的单元格上点击删除，则该值会恢复为“0”，并且单元格会变为红色。

当用户在范围内点击删除（或退格键）时，我需要代码进入最后一个 else 语句。任何建议将不胜感激。

    Private Sub Worksheet_Change(ByVal Target As Range)

    Dim inRange As Range

    Set inRange = Intersect(Target, Range("C3:N13"))

    If (Not (inRange Is Nothing)) Then
        If IsEmpty(Target) = False Then
            With Target.FormatConditions.Add(xlCellValue, xlEqual, "=0")
                .Interior.Color = 255
                .Font.Color = 255
            End With

            With Target.FormatConditions.Add(xlCellValue, xlGreater, 0)
                .Interior.Color = -11489280
                .Font.Color = -11489280
            End With
        Else
            With Target.Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
            If Target.Row Mod 2 = 0 Then
                With Target.Interior
                    .Pattern = xlNone
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            Else
                With Target.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent5
                    .TintAndShade = 0.799981688894314
                    .PatternTintAndShade = 0
                End With
            End If
        End If
    End If
End Sub

Answer 1

试试这个

---

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Cells.CountLarge = 1 Then   'continue only if one cell was edited (copy/paste)
            If Not Intersect(Target, Me.Range("C3:N13")) Is Nothing Then  'is within range
                Application.EnableEvents = False

                If Len(Trim$(.Value2)) > 0 Then         'not deletion
                    If .Value2 <> 1 Then .Value2 = 0    'not 0 or 1
                    Dim clr As Long
                    clr = IIf(.Value2 = 0, vbRed, RGB(0, 176, 80))  'red (or green if 1)
                   .Interior.Color = clr
                   .Font.Color = clr

                Else    'deletion (Del, Backspace, Space keys, or pastes empty string)

                    On Error Resume Next    'expected error: Nothing to Undo
                    Application.Undo        'determine previous value
                    On Error GoTo 0

                   .Borders.LineStyle = xlContinuous
                   .Borders.Weight = xlThin
                    If Len(Trim$(.Value2)) > 0 Then     'if previous val was not empty
                        Target.Value2 = 0
                       .Interior.Color = vbRed
                       .Font.Color = vbRed
                    End If
                End If
                Application.EnableEvents = True
            End If
        End If
    End With
End Sub

---

如果只有一个单元格被更新，并且在范围内

• 停止触发所有事件
• 如果用户没有删除
  • 如果用户输入 1（并且只接受 1 的值）- 单元格变为绿色
  • 如果输入 0 或任何其他数字或字母 - 单元格变为红色，值为 0
• 如果用户删除目标单元格（Del、Backspace、Space 键，或粘贴空字符串）
  • 显示边框（首次编辑）
  • 使用Application.Undo 确定先前的值（预期错误 - 没有可撤消的操作）
    • 如果先前为空 - 没有变化：单元格为空，没有颜色）
    • 如果先前不为空：单元格变为 0，颜色和字体变为红色
• 重新开启事件

---

注意：如果您使用公式，它应该检查有错误的单元格 (If Nor IsError(Target) Then)

如 cmets 中所述，您的代码不断重复条件格式规则（没有先删除它们）。该文件会随着时间的推移而变得臃肿，而且无论如何都不需要它们