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

您应该直接使用范围而不是使用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 2

尝试将数组连接成逗号分隔的字符串。（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中，使用&字符串连接效率很低，因为必须制作涉及的字符串的副本-但是如果您的用例可以，那么可以原样保留。

正如Gary的学生在他的答案中指出的那样，您也可以只使用joinedOutput = application.textjoin(arr, ",")（而不是循环），尽管我认为只有在拥有Office 365订阅的情况下此功能才可用。

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

一个很棒的请求答案列表。这是一个版本，在其中指示要选择项目的范围和插入新验证器的范围。只是更改了代码以添加对重复元素的检查，并添加了代码以检查数组是否为空。

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

用数组填充下拉列表

4 个答案: