如果单元格A为空，则清除列B到F的内容
我有一个工作表，其值取决于单元格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”循环的情况下执行我所需的操作。
您正在使用一个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中的单元格为空时
尝试这个：
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
试试这个：
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
它应该对时间影响最小。
使用范围对象。 下面这行代码将打印我们将用来清除内容的Range的地址。 第一个单元格调用获取范围的左上angular，第二个单元格调用获取范围的右下angular。
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
最后一个注意事项：即使发生错误，您也应该使用error handling程序来确保子项退出时始终启用事件。
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
在使用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
对于那些需要在一个单元格中input数据的情况（在列中），当另一列发生变化时，使用这个，这是对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
结束小组