Question

我在同一张Excel工作表上有两个表。
第一个表名为Cabinet，其范围为$ A $ 12：$ AN $ 29
第二个表名为LaminatedBench，范围为$ A $ 33：$ AN $ 50

对于“内阁”表：

我正在尝试：
清除/更改A12后，清除单元格：B12，C12，D12和H12。
清除/更改B12后，清除单元格：C12，D12和H12。
清除/更改C12后，清除单元格：D12和H12。

类似地：
清除/更改A13后，清除单元格：B13，C13，D13和H13。
清除/更改B13后，清除单元格：C13，D13和H13。
清除/更改C13后，清除单元格：D13和H13。
＆这适用于从第12行到第29行的所有行。

对于“ LaminatedBench”表：

我正在尝试：清除/更改A33后，清除单元格：B33，C33，D33，E33，F33，G33，H33和L33。
清除/更改B33时，清除单元格：C33，D33，E33，F33，G33，H33和L33。
清除/更改C33时，清除单元格：D33，E33，F33，G33，H33和L33。
清除/更改D33后，清除单元格：E33，F33，G33，H33和L33。
清除/更改E33后，清除单元格：F33，G33，H33和L33。
清除/更改F33后，清除单元格：G33，H33和L33。
清除/更改F33后，清除单元格：H33和L33。
＆这适用于从Row33到Row50的所有行。

我在第一行的表1中使用以下代码。我将添加更多表，并且必须为每行写几行代码。

如何在不添加每一行代码的情况下进行调整？

Private Sub Worksheet_Change(ByVal Target As Range)
End If
If Not Intersect(Target, Range("$A12")) Is Nothing Then
    Range("B12:D29").ClearContents
    Range("H12:H29").ClearContents
End If
If Not Intersect(Target, Range("$B12")) Is Nothing Then
    Range("C12:C29").ClearContents
    Range("H12:H29").ClearContents
End If
If Not Intersect(Target, Range("$A33")) Is Nothing Then
    Range("B33:H50").ClearContents
    Range("L33:L50").ClearContents
End If
If Not Intersect(Target, Range("$B33")) Is Nothing Then
    Range("C33:H50").ClearContents
    Range("L33:L50").ClearContents
End If
If Not Intersect(Target, Range("$C33")) Is Nothing Then
    Range("D33:H50").ClearContents
    Range("L33:L50").ClearContents
End If
If Not Intersect(Target, Range("$D33")) Is Nothing Then
    Range("E33:H33").ClearContents
    Range("L33:L50").ClearContents
End If
If Not Intersect(Target, Range("$E33")) Is Nothing Then
    Range("F33:H50").ClearContents
    Range("L33:L50").ClearContents
End If
If Not Intersect(Target, Range("$F33")) Is Nothing Then
    Range("G33:H50").ClearContents
    Range("L33:L50").ClearContents
If Not Intersect(Target, Range("$G33")) Is Nothing Then
    Range("H33:H50").ClearContents
    Range("L33:L50").ClearContents
End If
End If
End Sub

Answer 1

在桌子柜子里

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDB As Range
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("a12", "c29")) Is Nothing Then
        Set rngDB = Range(Target.Offset(, 1), Range("d" & Target.Row))
        Set rngDB = Union(rngDB, Range("h" & Target.Row))
        rngDB.ClearContents
    End If
End Sub

在LaminatedBench中

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDB As Range
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("a33", "d50")) Is Nothing Then
        Set rngDB = Range(Target.Offset(, 1), Range("h" & Target.Row))
        Set rngDB = Union(rngDB, Range("L" & Target.Row))
        rngDB.ClearContents
    End If
End Sub

Answer 2

我认为您对“ LaminatedBench”的叙述在该段的最后两句话中开始有些偏离。您似乎涵盖两次删除F33的问题。

将其放入工作表的私有代码表（右键单击工作表名称标签，查看代码），而不是公共模块代码表。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("A12:C29")) Is Nothing Then
        On Error GoTo safe_exit
        Application.EnableEvents = False
        Dim c As Range
        For Each c In Intersect(Target, Range("A12:C29"))
            If IsEmpty(c) Then _
                Intersect(c.Resize(1, 8), Range("A12:D29, H12:H29")).ClearContents
        Next c
    End If

    If Not Intersect(Target, Range("A33:G50")) Is Nothing Then
        On Error GoTo safe_exit
        Application.EnableEvents = False
        Dim lb As Range
        For Each lb In Intersect(Target, Range("A33:G50"))
            If IsEmpty(lb) Then _
                Intersect(lb.Resize(1, 12), Range("A33:H50, L33:L50")).ClearContents
        Next lb
    End If

safe_exit:
    Application.EnableEvents = True

End Sub

根据清除/更改另一个单元格并将其应用于所有行来清除单元格

2 个答案: