Изменить источник раскрывающегося списка на основе выбора пользователя в другом раскрывающемся списке

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

---

Другое решение (которое может быть лучше) - добавить третий столбец с формулой, чтобы проверить, находится ли значение в столбце a в AG3. В третьем столбце будет приведена формула: =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