vba - 将变量设置为等于多个选定的单元格

Question

I am attempting to get my code to work when multiple cells are selected/changed. 我不太确定从这里去哪里，因为当目标是多单元格选择时，我无法将变量设置为目标。

我需要的一个示例是：选择并删除第 1 列中的所有单元格，因此随后我希望也删除第 2 列中的所有单元格。相反，代码会返回错误并且不会删除任何选定行的第 2 列。

这是代码：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next

Application.ScreenUpdating = False
If Target.Column = 1 Then
    Application.EnableEvents = False

    Dim OldValue As String
    Dim NewValue As String

    NewValue = Target.Value

    Application.Undo
    OldValue = Target.Value

    Target.Value = NewValue

    Application.EnableEvents = True

    If OldValue = "" Then
    Exit Sub
    Else
        Application.EnableEvents = False
        Target.Offset(0, 1).ClearContents
        MsgBox "Contents related to this drop-down have been cleared"
    End If
End If

Exithandling:
    Application.EnableEvents = True
    Exit Sub

Application.ScreenUpdating = True
End Sub

标签： vbaexcel

Answer 1

像这样的东西：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range, oldVal, newVal, i As Long, num As Long, c As Range

    On Error GoTo haveError:

    'only process the part of Target which overlaps with ColA... 
    Set rng = Application.Intersect(Target, Me.Columns(1))

    'run some checks before proceeding...
    If rng Is Nothing Then Exit Sub
    If rng.Cells.Count = Me.Columns(1).Cells.Count Then Exit Sub 'ignore full-column operations
    If rng.Areas.Count > 1 Then Exit Sub             'handling multiple areas will be more complex...
    If Application.CountBlank(rng) = 0 Then Exit Sub 'no empty cells: nothing to do here

    Application.EnableEvents = False

    newVal = GetArray(rng)
    Application.Undo
    oldVal = GetArray(rng)
    rng.Value = newVal

    For Each c In rng.Cells
        i = i + 1
        If newVal(i, 1) = "" And oldVal(i, 1) <> "" Then
            c.Offset(0, 1).ClearContents
            num = num + 1
        End If
    Next c

    If num > 0 Then MsgBox "Contents related to drop-down(s) have been cleared"

haveError:
    If Err <> 0 Then Debug.Print Err.Description
    Application.EnableEvents = True

End Sub

'normalizes the array vs. scalar returned when calling .Value
'  on a multi- vs. single-cell range
Function GetArray(rng As Range)
    Dim arr
    If rng.Count > 1 Then
        arr = rng.Value
    Else
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = rng.Value
    End If
    GetArray = arr
End Function