[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAのDictionaryの使い方を教えてほしい』（どこむっち）
参照シートのJ列（重複有）をKEYとして、出力シートのB列から探して一致した場合は、
AW列に参照シートのJ列の値が表示⇒”紐づけ無”と表記されるよう変更したいです。
配列を勉強中のためネット上のコードをコピペして修正しているのですが、
どう修正したらよいかわからず手詰まりです。
どなたかわかる方コードを教えてください。
Sub 練習()
Dim LookupArray As Variant, RefArray As Variant Dim KeyValue As String, ItemValue As String, SearchKey As String Dim MaxRow As Long, i As Long, n As Long Dim Dictionary As Object
'時間計測用 Dim startTime As Double, endTime As Double, processTime As Double startTime = Timer '開始
Sheets("出力先シート").Select
MaxRow = Sheets("出力先シート").Cells(Rows.Count, 1).End(xlUp).Row '最終行を取得
LookupArray = Sheets("出力先シート").Range(Cells(2, 2), Cells(MaxRow, 49)) '出力用のセルを配列として格納
Sheets("参照用シート").Select
Maxrow1 = Sheets("参照用シート").Cells(Rows.Count, 1).End(xlUp).Row '最終行を取得
RefArray = Sheets("参照用シート").Range(Cells(2, 10), Cells(Maxrow1, 10)) '参照範囲のセルを配列として格納
Set Dictionary = CreateObject("Scripting.Dictionary")
'参照用の配列から辞書作成
For n = 1 To UBound(RefArray)
KeyValue = RefArray(n, 1)
ItemValue = RefArray(n, 1)
If Dictionary.Exists(KeyValue) = False Then
Dictionary.Add KeyValue, ItemValue
End If
Next n
'辞書から検索
For i = 1 To UBound(LookupArray)
SearchKey = LookupArray(i, 1)
LookupArray(i, 1) = Dictionary(SearchKey)
Next i
'結果出力
Sheets("出力先シート").Select
Sheets("出力先シート").Range(Cells(2, 49), Cells(MaxRow, 49)) = LookupArray
Set Dictionary = Nothing '辞書は空にしておく
endTime = Timer MsgBox endTime - startTime
End Sub
＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
<<出力シート>> <<参照シート>>
B列 AW列 J列
1 a 1 a
2 b 2 b
3 x 3 c
のとき、どういう結果を得たいのですか？ そこをハッキリ書いてください。 上のような表形式で回答してください。
＞AW列に参照シートのJ列の値が表示⇒”紐づけ無”と表記されるよう 日本語としてバグっているような、分かりにくい記述です。
（γ） 2022/02/17(木) 19:59
■現在の表示
<<出力シート>>
B列 AW列
1 a a
2 b b
3 x
■変更後の表示
<<出力シート>>
B列 AW列
1 a 紐づけ無
2 b 紐づけ無
3 x
となるようにしたいです。
（どこむっち） 2022/02/18(金) 08:36
＞配列を勉強中
とのことなので"連想"配列の勉強のためあえてそうしてるのかもしれませんが、KEYが、出力シートのB列にあるかどうかだけなら、普通にCOUNTIF関数で十分じゃないでしょうか
＞現在の表示
参照シートの例示もしていただくとより状況が把握できるようになるとおもいます。
γさんが示した通りということでしょうか？
（もこな２） 2022/02/18(金) 09:06
わかりにくくてすみません。
改めてどのようにしたいのかを記載します。
【参照シートのJ列（重複有）をKEYとして、出力シートのB列から探して一致した場合】
■現在の表示（出力シートのAW列に、参照シートのJ列の値が表示される）
<<出力シート>> <<参照シート>> <<出力シート>>
B列 AW列 J列 B列 AW列
1 a 1 a 1 a a
2 b 2 b → 2 b b
3 x 3 c 3 x
<<出力シート>> <<参照シート>> <<出力シート>>
B列 AW列 J列 B列 AW列
1 a 1 a 1 a 紐づき無
2 b 2 b → 2 b 紐づき無
3 x 3 c 3 x
（どこむっち） 2022/02/18(金) 10:06
Sub 研究用1()
Stop 'ブレークポイントの代わり
Dim 行 As Long
With Worksheets("出力シート")
For 行 = 1 To .Cells(.Rows.Count, "B").End(xlUp).Row
If WorksheetFunction.CountIf(Worksheets("参照シート").Range("J:J"), .Cells(行, "B").Value) > 0 Then
.Cells(行, "AW").Value = "紐づき無"
End If
Next
End With
End Sub
■２
＞調べたところDictionaryが高速とありましたので
何と比較したのですか？それは困るほどの差なのですか？
確かに、１セルずつ書き込むより、配列に格納してから一気に書き出すほうが処理速度の向上は望めるとは思います。
ただ、それがどの程度変わるかは環境や個人の主観によって左右されますし、まずは時間は気にせず目的の処理ができるようになってから処理速度について考えてみてはいかがでしょうか？
（いやいや、目的を達成するだけなら既にできているのだということなら余計な一言失礼しました。）
〜〜（別用があるので一旦区切ります）〜〜
（もこな２） 2022/02/18(金) 11:37
申し訳ないが、例が理解できないので、以下の例でコードを示します。 参考にしてください。
<<Sheet1>> <<Sheet2>>
A列 B列 A列
1 a 1 a
2 b 2 b
3 c 3 c
4 d 4 e
5 f
↓
A B A
1 a match 1 a
2 b match 2 b
3 c match 3 c
4 d matchせず 4 e
5 f
Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim dic As Object
Dim mat, mat2
Dim e
Dim k As Long
'検索範囲のデータをdictionaryに保持
Dim lastRow As Long
Set ws2 = Sheets("Sheet2")
lastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
mat = ws2.Range(ws2.Cells(1, "A"), ws2.Cells(lastRow, "A"))
Set dic = CreateObject("Scripting.Dictionary")
For Each e In mat
dic(e) = Empty
Next
'検索実行
Set ws1 = Sheets("Sheet1")
lastRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
mat2 = ws1.Range(ws1.Cells(1, "A"), ws1.Cells(lastRow, "B"))
For k = 1 To UBound(mat2, 1)
If dic.Exists(mat2(k, 1)) Then
mat2(k, 2) = "match"
Else
mat2(k, 2) = "matchせず"
End If
Next
'ワークシートに出力
ws1.Range(ws1.Cells(1, "A"), ws1.Cells(lastRow, "B")) = mat2
End Sub
（γ） 2022/02/18(金) 12:47
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.