Wie füge ich aus einem Skriptwörterbuch ein Array in ein Dropdown-Feld in der Zelle ein?

Question

Ich habe einen Daten-Dump aus verschiedenen Anwendungen. Ich möchte eindeutige Werte aus einer einzelnen Spalte im Daten-Dump erhalten (die variable Länge hat). Sobald ich die eindeutigen Werte habe, möchte ich, dass sie von der Datenvalidierung in einen. Ich habe das meiste davon herausgefunden, außer für den letzten Teil, wo ich den Fehler bekomme, wenn ich renne: Runtime Application Error: "1004" Anwendung oder Objekt definiert Fehler. Siehe unten:

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 

Der Debugger sagt das Problem ist das d.Keys() von Scripting. Ich habe jedoch versucht, mit Join (d.Keys(), ",") in eine Zeichenfolge zu konvertieren und diese neue Variable in der Datenvalidierung aufzurufen, die den gleichen Fehler ergibt. Ich bin dies auf Excel 2010 ausgeführt.

Ich dachte, dies könnte auch ein Problem sein, dass die Variante Array 2D ist und es muss 1D sein, aber das scheint nicht der Fall zu sein. Mit Verlust und Hoffnung, dass jemand helfen kann.

Best,

Anthony

Answer 1

für mich Dies funktioniert. xlValidateList erwartet eine Liste, die durch Kommas (oder einen Bereich) getrennt ist. Ich habe auch die Select- und Activate-Anweisungen entfernt, die nicht benötigt werden, und den Code langsamer machen.

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

Dies scheint zu funktionieren:

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