Выпадающий список не заполняется из коллекции предметов

Question

Примечание: это не мой оригинальный код. Мне нужна помощь в заполнении выпадающего списка в Excel sheet1 из коллекции, которую я создал, используя данные в столбцах F & G sheet2. Мне также нужна помощь в удалении дубликатов из общего списка. Debug.print отображает все элементы в группе, но проверка раскрывающегося списка приводит к отображению только первого элемента из столбцов sheet2 в ячейке B6 на sheet1, выбранном как раскрывающийся список. Каждый элемент в столбцах Листа 2 F & G имеет формат. Вот код, который я имею до сих пор, любезно предоставленный несколько фрагментов, размещенных на этом сайте и объясненных во многих других. Спасибо им за соответствующие фрагменты кода. В моем коде пока нет удаления дубликатов, поскольку я запутался в заполнении выпадающего списка.

Спасибо

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

Answer 1

Самый простой способ сделать выпадающий список 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 или коллекции:

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