2

我有来自不同应用程序的数据转储。我想从数据转储中的奇异列（具有可变长度）中获取唯一值。一旦我有了唯一值，我希望将它们从数据验证中调用到 .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 的问题，但似乎并非如此。

4

2 回答 2

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
于 2017-10-30T16:14:07.773 回答
1

这似乎有效：

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
于 2017-10-30T19:32:40.850 回答