Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

15021 / 76734

←次へ　｜　前へ→


	【67198】Re:dictionary　オブジェクトについて

Hirofumi - 10/11/15(月) 11:35 -


	引用なし

	パスワード

Dictionaryの使い方が違うのでは？

Option Explicit

Public Sub Test_1()
　　
　　Dim MyD As Object
　　Dim MyVal As Variant, MyVal2 As Variant
　　Dim MyDate As Date
　　Dim i As Long
　　
　　Set MyD = CreateObject("scripting.dictionary")
　　
　　With Sheets("シート1")
　　　　'2行目～最終行まで繰り返し
　　　　For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
　　　　　　'KeyとしてA列の値を取得
　　　　　　MyVal = .Cells(i, "A").Value '品番
　　　　　　'日付を取得
　　　　　　MyDate = .Cells(i, "C").Value
　　　　　　'Dictionaryに登録が無かったら
　　　　　　If Not MyD.Exists(MyVal) Then
　　　　　　　　'品番をKeyとして.code、日付を登録
　　　　　　　　MyD.Add MyVal, Array(.Cells(i, "B").Value, MyDate)
　　　　　　Else
　　　　　　　　MyVal2 = MyD(MyVal)
　　　　　　　　'登録している日付より現在の日付が先なら
　　　　　　　　If MyVal2(1) > MyDate Then
　　　　　　　　　　'Dictionaryの日付を入れ替える
　　　　　　　　　　MyVal2(1) = MyDate
　　　　　　　　　　'再登録
　　　　　　　　　　MyD(MyVal) = MyVal2
　　　　　　　　End If
　　　　　　End If
　　　　Next i
　　End With
　　
　　With Sheets("シート2")
　　　　'List先頭～最終まで繰り返し
　　　　For i = 4 To .Range("A" & Rows.Count).End(xlUp).Row
　　　　　　'KeyとしてA列の値を取得
　　　　　　MyVal = .Cells(i, "A").Value
　　　　　　'Dictionaryに登録が在ったら
　　　　　　If MyD.Exists(MyVal) Then
　　　　　　　　.Cells(i, "B").Value = MyD(MyVal)(0) 'code
　　　　　　　　.Cells(i, "C").Value = MyD(MyVal)(1) '日付
　　　　　　End If
　　　　Next i
　　End With

End Sub

リソースを無視すればもう少し速く成るかも？

Public Sub Test_2()
　　
　　Dim MyD As Object
　　Dim MyVal() As Variant, MyVal2() As Variant
　　Dim i As Long
　　Dim lngRowEnd As Long
　　
　　Set MyD = CreateObject("scripting.dictionary")
　　
　　With Sheets("シート1")
　　　　'最終行取得
　　　　lngRowEnd = .Range("A" & Rows.Count).End(xlUp).Row
　　　　'A、B、C列を配列として取得
　　　　MyVal = .Range(.Cells(2, "A"), .Cells(lngRowEnd, "C")).Value
　　　　'2行目～最終行まで繰り返し
　　　　For i = 1 To UBound(MyVal, 1)
　　　　　　'Dictionaryに品番登録が無かったら
　　　　　　If Not MyD.Exists(MyVal(i, 1)) Then
　　　　　　　　'品番をKeyとして.code、日付を登録
　　　　　　　　MyD.Add MyVal(i, 1), i
　　　　　　Else
　　　　　　　　'登録している日付より現在の日付が先なら
　　　　　　　　If MyVal(MyD(MyVal(i, 1)), 1) > MyVal(i, 3) Then
　　　　　　　　　　'Dictionaryの行位置を入れ替える
　　　　　　　　　　MyD(MyVal(i, 1)) = i
　　　　　　　　End If
　　　　　　End If
　　　　Next i
　　End With
　　
　　With Sheets("シート2")
　　　　'最終行取得
　　　　lngRowEnd = .Range("A" & Rows.Count).End(xlUp).Row
　　　　'A、B、C列を配列として取得
　　　　MyVal2 = .Range(.Cells(4, "A"), .Cells(lngRowEnd, "C")).Value
　　　　'List先頭～最終まで繰り返し
　　　　For i = 1 To UBound(MyVal2, 1)
　　　　　　'Dictionaryに登録が在ったら
　　　　　　If MyD.Exists(MyVal2(i, 1)) Then
　　　　　　　　MyVal2(i, 2) = MyVal(MyD(MyVal2(i, 1)), 2) 'code
　　　　　　　　MyVal2(i, 3) = MyVal(MyD(MyVal2(i, 1)), 3) '日付
　　　　　　End If
　　　　Next i
　　　　'結果を出力
　　　　With .Range(.Cells(4, "A"), .Cells(lngRowEnd, "C"))
　　　　　　.ClearContents
　　　　　　.Value = MyVal2
　　　　End With
　　End With

End Sub

0 hits

▼

【67160】dictionary　オブジェクトについて Tacchi 10/11/12(金) 15:03