Question

我写了一些代码来更改下拉列表的来源。当用户从AG3中的列表中选择一个值时，AG4的来源就会更改。它可以在Excel 64中运行，但是当有人尝试在Excel 32中运行该程序时，我收到一条错误消息，指出该过程太大。

我试图找出如何将所有值和源范围放入数组中，但是我无法弄清楚。

  If Not Intersect(Target, Range("AG3")) Is Nothing And InStr(1, Range("AG3"), "5.75") > 0 Then
        With Range("AG4").Validation
            .Delete
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="='DropdownLists'!P2:P6"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
End If

我粘贴了其中的100个，只是更改了用户选择（5.75）和AG4中下拉列表的范围（P2：P6）。如果有人可以告诉我如何将这些值放在数组中，我想我可以修复它。

Answer 1

首先，将值写在工作表中，如下所示：

    A  |           B            |  C   |   D    ....
   5.75| 'DropdownLists'!P2:P6  |      |
   ...
   100.

然后，为范围A1：B100（或您所说的大约100）命名。（在此示例中为"ArrayInRange"）

然后，您可以按以下方式将值加载到数组中：

Dim Arr() as Variant
Arr = Range("ArrayInRange")

因此，您可以通过以下方式替换事件处理程序：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Arr() As Variant, i As Long
    If Intersect(Target, Range("AG3")) Is Nothing Then Exit Sub 'Check once instead of 100
    Arr = Range("ArrayInRange")
    For i = LBound(Arr,1) To UBound(Arr,1)
        If InStr(1, Range("AG3"), Arr(i, 1)) > 0 Then
            With Range("AG4").Validation
                .Delete
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="=" & Arr(i, 2)
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        End If
    Next
End Sub

另一种解决方法（可能更好）是添加带有公式的第三列，以检查是否在AG3中找到了a列中的值第三栏中的公式将是： =IFERROR(FIND(A1,$AG$3),"")

然后，您可以使用此事件处理程序：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim R As Variant
    If Not Intersect(Target, Range("AG3")) Is Nothing Then 'Check once instead of 100
        R = WorksheetFunction.Match(0, Range("ArrayInRange").Paternt.Columns(3), -1)
        If Not IsError(R) Then
            With Range("AG4").Validation
                .Delete
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="=" & Range("ArrayInRange").Cells(R, 2).Value
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        End If
    End If
End Sub

根据另一个下拉菜单中的用户选择更改下拉列表源

1 个答案: