如何将数组从脚本字典添加到单元格内下拉列表中

Question

我有一个来自不同应用程序的数据转储。我想从数据转储中的单数列（长度可变）中获取唯一值。一旦我有了唯一值，我希望它们从数据验证中被调用到 .incelldropdown 中。我已经弄清楚了大部分问题，除了我收到错误的最后一部分：

Runtime Application Error: "1004" Application or object defined error. 

见下文：

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 需要一个以逗号（或范围）分隔的列表。我还删除了不需要的选择和激活语句，并减慢了代码速度。

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