如果单元格 A 为空，则清除 B 到 F 列的内容

Question

我有一个工作表，其值取决于单元格 A。如果 A 列中的一行包含一个值，那么 B 列到 H 列中的单元格将相应更改。

如果 A 列的单元格为空，我想重置 D 列到 F 列的单元格。

我写下了以下 VBA 代码

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim n As Integer
    For n = 5 To 75
        Application.EnableEvents = False
        If VarType(Cells(n, 1)) = vbEmpty Then
           Cells(n, 4).ClearContents
           Cells(n, 5).ClearContents
           Cells(n, 6).ClearContents
        Application.EnableEvents = True
        End If
    Next n
End Sub

“FOR”循环很烦人，并且在进入任何单元格后使 Excel 暂停 1 秒或更长时间，任何人都可以帮助我更正上述代码以在没有“FOR”循环的情况下完成我需要做的事情。

Answer 1

您正在使用 Worksheet_Change 事件，每次发生变化时都会迭代 70 行。

相反，尝试

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim n As Long

    If Target.Column = 1 Then
        If IsEmpty(Cells(Target.Row, 1)) Then
               Range("B" & Target.Row & ":F" & Target.Row).ClearContents
        End If
    End If
End Sub

如果您从 A 列中删除一个值 => 当 A 列中的单元格为空时，这只会清除单元格

Answer 2

尝试这个：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
If Mid(Target.Address(1, 1), 1, 2) = "$A" Then
    If Target.Cells(1, 1).Value = "" Then
        For i = 4 To 6
            Target.Cells(1, i).Value = ""
        Next i
    End If
End If
End Sub

Answer 3

试试这个：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rLook As Range, r As Range, Intr As Range
    Set rLook = Range("A5:A75")
    Set Intr = Intersect(rLook, Target)
    If Intr Is Nothing Then Exit Sub
    Application.EnableEvents = False
        For Each r In Intr
            If r.Value = "" Then
                rw = r.Row
                Range("D" & rw & ":F" & rw).ClearContents
            End If
        Next r
    Application.EnableEvents = True
End Sub

它应该对时间的影响最小。

Answer 4

使用范围对象。 以下代码行将打印我们将用于清除内容的 Range 的地址。 第一个单元格调用获取范围的左上角，第二个单元格调用获取范围的右下角。

Private Sub test()
    Debug.Print Range(Cells(5, 4), Cells(75, 6)).Address
End Sub

我们将其应用到您的代码中，如下所示：

Private Sub Worksheet_Change(ByVal Target As Range)
    If VarType(Cells(Target.Row, 1)) = vbEmpty Then
        Application.EnableEvents = False
        Range(Cells(Target.Row, 4), Cells(Target.Row, 6)).ClearContents
        Application.EnableEvents = True
    End If
End Sub

最后一个旁注：您应该使用错误处理程序来确保在子退出时始终启用事件，即使发生错误也是如此。

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrHandler

    If VarType(Cells(Target.Row, 1)) = vbEmpty Then
        Application.EnableEvents = False
        Range(Cells(Target.Row, 4), Cells(Target.Row, 6)).ClearContents
    End If
ExitSub:
    Application.EnableEvents = True
    Exit Sub
ErrHandler:
    MsgBox "Oh Noes!", vbCritical
    Resume ExitSub
End Sub

Answer 5

使用 Change 事件时，您应该禁用事件并满足多个单元格的需求。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Intersect(Columns("A"), Target)
If rng1 Is Nothing Then Exit Sub

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

For Each rng2 In rng1.Cells
If IsEmpty(rng2.Value) Then rng2.Offset(0, 1).Resize(1, 5).ClearContents
Next

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub

Answer 6

对于那些需要在另一列发生变化时清除一个单元格中输入的数据（在列中）的人，请使用它，这是对 Gary's Student 的修改。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rLook As Range, r As Range, Intr As Range
Set rLook = Range("D:D")
Set Intr = Intersect(rLook, Target)
If Intr Is Nothing Then Exit Sub
Application.EnableEvents = False
    For Each r In Intr
        If r.Value = "" Then
            rw = r.Row
            Range("L:L").ClearContents
        End If
    Next r
Application.EnableEvents = True

结束子