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

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期望以逗号（或范围）分隔的列表。我还删除了不需要的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