2

私は別のアプリケーションからデータダンプを持っています。私は、可変長のデータ・ダンプ内の特異な列から一意の値を取得したい。一意の値を取得したら、データ検証から.incelldropdownに呼び出す必要があります。私は、実行時にエラーが発生する最後の部分を除いて、これのほとんどを理解しました:ランタイムアプリケーションエラー: "1004"アプリケーションまたはオブジェクト定義エラー。以下を参照してください:スクリプト辞書のin cellドロップダウンリストに配列を追加するにはどうすればいいですか?

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()であると言います。しかし、私は結合(d.Keys()、 "、")を使用して文字列に変換しようとし、同じエラーをもたらすデータ検証でその新しい変数を呼び出しました。私はこれをexcel 2010で実行しています。

これはバリアント配列が2Dであり、1Dである必要がありますが、そうではないように思われると考えました。喪失して、誰かが助けてくれると願っています。

ベスト、

アンソニー

+0

あなたは 'ユニークな値が含まれてRangeArray'か? –

+0

あなたは[この解決策を試しましたか?](https://stackoverflow.com/questions/39162841/is-it-ppossible-to-use-autofilter-or-find-on-a-dictionary)リストをフィルタリングする 'cboEEList_Change()'を取り出してください。 – danieltakeshi

+0

ここで 'd(RangeArray(i、1))= 1'は、値1を辞書に挿入しています。 – danieltakeshi

答えて

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 
+0

このコードは私のためにも実行されましたが、出力は配列の最初の4つの値だけを与えています。配列自体には正確な値が設定されています。セル(1,40).Resize(UBound(d.Keys())+ 1,1)= Application.WorksheetFunction.Transpose(d.Keys())。何か案は? – Tony

+0

おかしい、私はそれを複製することはできません。いくつの値を表示する必要がありますか? – SJR

+0

これは、約670のアイテムを表示する必要があり、前述のように、最初に私に表示されているだけです。 – Tony

0

これは動作するように表示されます。

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 
関連する問題