当其左侧的单元格发生变化时清除单元格的内容

Question

我正在尝试获取一段代码，当第8列中的单元格更改时，它会删除它旁边的单元格的值（第9列）。 好吧...那是简单的版本

第8列和第9列都是下拉列表，第9列中的下拉列表取决于第8列。在第9列中，必须有多个答案，因此我在互联网上找到了使之成为可能的代码，但现在第9列中的值不再当我更改第8列中的值时，不会自动删除。下面的这段代码有效，但仅当我当时更改1个单元格（在第8列中）时才有效。 当我在第8列中粘贴多个单元格或在第8列中选择一个单元格然后将其向下拖动时（从右下角开始），它不起作用。

我没有太多的编码经验，而且似乎找不到合适的解决方案。 多亏了QHarr，我才走得更远。 这是我的第二次尝试：

Dim ClearC9 As String
Dim i As Long
For i = 2 To 1000
    If Target.Cells.Count > 1 Then GoTo ClearC9
    If Not Intersect(Target, Range("H" & i)) Is Nothing Then
        Range("I" & i).ClearContents
    End If
    Next i

exitHandler:
Application.EnableEvents = True

  Columns("I:I").EntireColumn.AutoFit

ClearC9:
Selection.Offset(, 1).ClearContents

第一次尝试：

Dim i As Long
For i = 2 To 1000
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("H" & i)) Is Nothing Then
Range("I" & i).ClearContents
End If

这是完整的代码：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lUsed As Long
If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
  If Target.Column = 9 Then
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
        lUsed = InStr(1, oldVal, newVal)
        If lUsed > 0 Then
            If Right(oldVal, Len(newVal)) = newVal Then
                Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
            Else
                Target.Value = Replace(oldVal, newVal & ", ", "")
            End If
        Else
            Target.Value = oldVal _
              & ", " & newVal
        End If
    End If
    End If
  End If
End If
Dim i As Long
For i = 2 To 1000
If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("H" & i)) Is Nothing Then
        Range("I" & i).ClearContents
    End If
Next i

exitHandler:
  Application.EnableEvents = True

  Columns("I:I").EntireColumn.AutoFit
End Sub

Answer 1

创建交集范围的一般模式：

1. 如果什么都Nothing那就什么也不做
2. 否则循环其细胞

例如：

     Private Sub Worksheet_Change(ByVal Target As Range)
     Dim rngDV As Range, TheIntersection As Range, r As Range

    '       stuff

    TheIntersection = Intersect(Target, rngDV)
    If TheIntersection Is Nothing Then
        '   do nothing
    Else
        For Each r In TheIntersection
            '   do something
        Next r
    End If
End Sub