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”循环很烦人，并且在任何进入任何Cell之后让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 =＆gt;中删除值，则只会清除单元格当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的学生的修改。

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

End Sub

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

6 个答案: