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

Clear the contents of columns B to F if cell A is empty

提问by PCArts

I have a worksheet with values depending on Cell A. If a row in column A contains a value then cells from Columns B through H will be changed accordingly.

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

If Cell of Column A is empty I want to reset the cells from columns D through F.

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

I wrote down the following VBA Code

我写下了以下 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

The "FOR" Loop is annoying, and making the Excel to pause for 1 second or more after any entry to any Cell, can anyone help me correct the above code to do what I need to do without the "FOR" loop.

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

回答by

You are using a Worksheet_Change event and you iterating through 70 rows each time something changes.. this is a bad approach for this kind of problem and that's why there is a delay.

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

Instead, try

相反，尝试

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

this will only clear the cells if you remove a value from column A => when cell in column A is empty

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

回答by Lukas2

Try this:

尝试这个：

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

回答by Gary's Student

Give this a try:

试试这个：

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

It should have minimal impact on timing.

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

回答by brettdj

You should disable events and cater for multiple cells when using the Change event.

使用 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

回答by Mike McCormick

For those that need to have data entered in one cell cleared (in a column) when there's a change in another column use this, which is a modification of Gary's Student.

对于那些需要在另一列发生变化时清除一个单元格中输入的数据（在列中）的人，请使用它，这是对 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

End Sub

结束子

回答by RubberDuck

Use a range object. The following line of code will print the address of the Range we'll use to clear the contents. The first cells call gets the upper left corner of the range, the second cells call gets the lower right corner of the range.

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

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

We apply this to your code like this:

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

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

One final sidenote: You should use an error handler to make sure events are always enabled when the sub exits, even if an error occurs.

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

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