Question

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

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

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

如果用户在一直为空的单元格上删除（从未输入任何数据），则代码按预期工作。但如果用户在已输入数据的单元格上删除，则会将该值恢复为＆＃34; 0＆＃34;细胞变红了。

当用户在范围内（或退格时）触及删除时，我需要代码进入最后一个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）

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

删除excel值＆amp;将单元格设置为空

1 个答案: