下拉列表未从项目集合中填充

时间:2020-03-28 16:07:28

标签: excel vba

注意:这不是我的原始代码。 我需要从使用sheet2的F和G列中的数据创建的集合中填充excel sheet1中的下拉列表的帮助。我还需要帮助,以消除总数中的重复项。 Debug.print显示collein函数中的所有项目,但下拉列表验证结果仅显示设置为下拉列表的sheet1的单元格B6中sheet2列中的第一项。在Sheet2列F&G中的每个项目都是fornat。这是我到目前为止拥有的代码,这要感谢本网站上发布的一些摘要,并在许多其他文章中进行了解释。感谢他们提供了相关的代码片段。我的代码尚不包含重复消除功能,因为首先我在填充下拉列表时迷失了。

谢谢

Sub MonitorNames()
Dim s As Variant
Dim r As Long
Dim nr As Long
Dim wr As Range, v, p
Dim c As Collection
Dim i As Integer

Set c = New Collection
Set wr = ThisWorkbook.Worksheets("Sheet2").Range("F1:G180")
'ThisWorkbook.Worksheets("Sheet1").Range("B" & 6) = ""

nr = wr.Rows.Count
s = ""

For r = 3 To nr
    v = wr(r, 1)
    p = wr(r, 2)
    s = v & "," & p
    c.Add s
Next

Range("B" & 6).Select 'This is in sheet1

With Selection.Validation
    .Delete
Debug.Print c.Item(1)
Debug.Print c.Item(c.Count)
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=c.Item(1), Formula2:=c.Item(c.Count)
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
'    Next i
End With
End Sub

1 个答案:

答案 0 :(得分:0)

使DV下拉菜单最简单的方法是使用逗号分隔的字符串。例如:

Sub InternalString()

    With Range("B2").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="alpha,beta,gamma,delta"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

我们可以从范围或内部VBA数组或Collection中创建字符串:

Sub DVfromCollection()
    Dim c As Collection
    Set c = New Collection

    c.Add "Larry"
    c.Add "Moe"
    c.Add "Curley"
'*********************************************************
    Dim s As String
    For i = 1 To c.Count
        s = c.Item(i) & IIf(s = "", "", ",") & s
    Next i
    With Range("C2").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

enter image description here