Как добавить массив в выпадающий список в ячейке из словаря сценариев?

Question

У меня есть дамп данных из другого приложения. Я хочу получить уникальные значения из единственного столбца в дампе данных (который имеет переменную длину). Как только у меня появятся уникальные значения, я хочу, чтобы они были вызваны в.incelldropdown из проверки данных. Я выяснил большую часть этого, за исключением последней части, где я получаю сообщение об ошибке при запуске: Ошибка приложения времени выполнения: "1004" Ошибка приложения или объекта. Увидеть ниже:

Sub TitleRange()

Dim sheet As Worksheet
Dim LastRow As Long
Dim StartCell As Range
Dim RangeArray As Variant


Worksheets("Raw").Select
Set sheet = Worksheets("Raw")
Set StartCell = Range("A2")

'Find Last Row
 LastRow = Cells(Rows.Count, "A").End(xlUp).Row

'Select Range & load into array
 RangeArray = sheet.Range("A2:A" & LastRow).Value



Dim d As Object
Set d = CreateObject("Scripting.Dictionary")


Dim i As Long
For i = LBound(RangeArray) To UBound(RangeArray)
d(RangeArray(i, 1)) = 1
Next i

Dim v As Variant
For Each v In d.Keys()
'd.Keys() is a Variant array of the unique values in RangeArray.
'v will iterate through each of them.
Next v


'This code below gives me a problem
Worksheets("PR Offer Sheet").Select
Range("C1").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=d.Keys()
.InCellDropdown = True

End With

Отладчик говорит, что проблема в d.Keys() из сценариев. Однако я попытался преобразовать в строку, используя Join (d.Keys(), ",") и вызывая эту новую переменную в проверке данных, которая выдает ту же ошибку. Я бегу это на Excel 2010.

Я думал, что это также может быть проблемой, что вариантный массив является 2D, и он должен быть 1D, но это не так. В недоумении и надежде кто-то может помочь.

Лучший,

Энтони

Answer 1

Это работает для меня. xlValidateList ожидает список, разделенный запятыми (или диапазон). Я также удалил ненужные операторы Select и Activate и замедлил код.

Sub TitleRange()

Dim sheet As Worksheet
Dim LastRow As Long
Dim RangeArray As Variant
Dim i As Long
Dim d As Object

Set sheet = Worksheets("Raw")

With sheet
    'Find Last Row
    LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    'Select Range & load into array
    RangeArray = .Range("A2:A" & LastRow).Value
End With

Set d = CreateObject("Scripting.Dictionary")

For i = LBound(RangeArray) To UBound(RangeArray)
    d(RangeArray(i, 1)) = 1
Next i

With Worksheets("PR Offer Sheet").Range("C1").Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(d.Keys, ",")
    .InCellDropdown = True
End With

End Sub

Answer 2

Это похоже на работу:

Sub MAIN2()
    Dim it As Range, r As Range, x0, s As String
        With CreateObject("scripting.dictionary")
            For Each it In Sheets("Raw").Columns(1).SpecialCells(2).Offset(1)
                x0 = .Item(it.Value)
            Next

            s = Join(.Keys, ",")

        End With
        With Worksheets("PR Offer Sheet").Range("C1").Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=s
                .InCellDropdown = True
        End With
End Sub