Заполнение выпадающего с массивом

Question

Проблема кажется простой, но я ничего не могу найти.Я хочу заполнить выпадающий список (в Excel, а не в пользовательской форме) значениями массива.до сих пор я создал массив и теперь хочу передать его только в раскрывающемся списке.Звучит достаточно просто.

Здесь код для создания выпадающего

Worksheet("Example").Cells(i,13).Select 'original here was a  . range but i need it to be variable therefore i used cells
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:= ArrayNAme 'not working
        .IgnoreBlank = False
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True

    End With

Я не получаю сообщение об ошибке, но также не появляется выпадающий.Кто-нибудь знает, что я делаю неправильно?

---

Некоторые хорошие, плохие новости ^^ Теперь создан и заполнен выпадающий список.К сожалению, заполнение не совсем верно.

Последнее значение всегда является числом, и массив не удаляется должным образом при следующем цикле, поэтому картинка выглядит следующим образом:

Первый выпадающий список: «правильное значение"," правильное значение "" 2 "'не должно быть числа

Второе раскрывающееся меню:" значение из первого раскрывающегося списка "," значение из первого раскрывающегося списка "," 2 "," новое правильное значение, ...

Надеюсь, это понятно. Вот мой текущий код.

Dim joinedOutput As String
Dim index As Long
For index = LBound(ArrDropdown, 1) To (UBound(ArrDropdown, 1) - 1)
    joinedOutput = joinedOutput & ArrDropdown(index) & ","
Next index
joinedOutput = joinedOutput & UBound(ArrDropdown, 1)

    Set rng = Worksheets("Transfer").Cells(j, 13)

    With rng.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=joinedOutput
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With

   Erase ArrDropdown

Answer 1

Отличный список сказочных ответов на запрос.Вот версия, в которой вы указываете диапазон, в котором нужно выбрать элементы для выбора, и диапазон, в который нужно вставить новые валидаторы.Просто изменили код, чтобы добавить проверку на повторяющиеся элементы, и добавили код, чтобы проверить, не является ли массив пустым.

Public Sub addDropDownValidator(ByRef rangeToAddDropDown As Variant, ByVal rangeListValidators As Variant)
Dim aFilledArray() As Variant, cell As range, count As Long, x As Long, strTemp As String, dupBool As Boolean

If TypeName(rangeToAddDropDown) = "Range" And TypeName(rangeListValidators) = "Range" Then
    count = 0
    dupBool = False
    For Each cell In rangeListValidators
        strTemp = Trim(cell.Value2)
        If Len(strTemp) > 0 Then
            If count > 0 Then
                dupBool = False
                For x = LBound(aFilledArray) To UBound(aFilledArray)
                    If strTemp = aFilledArray(x) Then
                        dupBool = True
                        Exit For
                    End If
                Next x
            End If
            If Not dupBool Then
                If count = 0 Then
                    ReDim aFilledArray(0 To 0)
                Else
                    ReDim Preserve aFilledArray(0 To UBound(aFilledArray) + 1)
                End If
                aFilledArray(count) = strTemp
                count = count + 1
            End If
        End If
    Next cell
    If Not isArrayEmpty(aFilledArray) Then
        With rangeToAddDropDown.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(aFilledArray, ",")
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End If
    Erase aFilledArray
Else
    MsgBox "Wrong Data Type!"
End If

End Sub

'To determine if a one-dimension array is empty; only works with one-dimension arrays
Public Function isArrayEmpty(ByVal aArray As Variant) As Boolean

On Error Resume Next
isArrayEmpty = IsArray(aArray) And Len(Join(aArray, "")) = 0
Err.Clear: On Error GoTo 0

End Function

Answer 2

Вместо использования Selection вы должны работать с диапазоном напрямую.Посмотрите на это редактирование вашего кода:

    Dim rng As Range
    Dim ArrayName() As Variant 'this is whatever your array is (not shown in your code)

    Set rng = ThisWorkbook.Worksheets("Example").Cells(i, 13)

    With rng.Validation
        .Delete
        .Add Type:=xlValidateList, _
             AlertStyle:=xlWalidAlertStop, _
             Operator:=xlEqual, _
             Formula1:=Join(ArrayName, ",")
        .IgnoreBlank = False
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With

Join(ArrayName, ",") возьмет содержимое вашего массива и превратит его в строку с каждым элементом, разделенным ","

Answer 3

Вот пример использования внутреннего массива VBA, преобразованного в строку:

Sub InternalString()

    Dim arr(1 To 3) As String, s As String
    arr(1) = "Winken"
    arr(2) = "Blinken"
    arr(3) = "Nod"
    s = Application.WorksheetFunction.TextJoin(",", True, arr)

    With ActiveCell.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=s
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

Примечание:

• мы используем функцию листа TextJoin ()
• TextJoin () может обрабатывать как массивы VBA, так и диапазон ячеек таблицы.

Answer 4

Попробуйте объединить ваш массив в строку через запятую. (Vba.Strings.Join() может помочь, если это строковый массив; в противном случае вам может потребоваться зациклить его и использовать оператор конкатенации &).

Скажем, ваш массив называется arr и является одномерным, вы можете попробовать следующее:

Dim joinedOutput as string
Dim index as long
For index = lbound(arr,1) to (ubound(arr,1)-1)
    If not isnumeric(arr(index)) then
        joinedOutput = joinedOutput & arr(index) & ","
    End if
Next index
If not isnumeric(arr(ubound(arr,1))) then
    joinedOutput = joinedOutput & ubound(arr,1)
End if

А затем введите строку joinedOutput в качестве аргумента для параметра Formula1:= ниже.

With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:=joinedOutput
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With

Затем присвойте (чтобы новый раскрывающийся список не имел значений предыдущего раскрывающегося списка):

joinedOutput = vbnullstring

Повтор цикла. Использование & конкатенации строк в VBA неэффективно, поскольку необходимо создавать копии задействованных строк - но если это нормально для вашего варианта использования, то можно оставить все как есть.

Как указывает студент Гэри в своем ответе, вы также можете просто использовать joinedOutput = application.textjoin(arr, ",") (вместо цикла), хотя я думаю, что эта функция доступна только при наличии подписки на Office 365.