如果單元格 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

結束子