VLOOKUP・MATCH・連想配列

VLOOKUP関数は便利ですが初心者にはとりつきにくい関数です。また奥が深い関数でもあり、様々なシーンで使うことができます。ここでは関数とVBAデ使う方法を合わせて紹介します。

1.VLOOKUP関数の基本機能

3.VLOOKUPの近似値機能を使う

4.VLOOKUPで1対nの処理をする

5.MATCHで1対nの処理をする

6.扶養者がいない社員のリストへの追加(MATCHの使用)

7.扶養者がいない社員のリストへの追加(MATCHの使用その２)

Applicatiom.WorksheetFunction → WorksheetFunctionに変更(VBAから呼び出すなら同義のため　2024.9.8)

8.VLOOKUPもMACHも使わない(連想配列=dictionary)

9.dictionaryを使って多項目を扱う

10.dictionary使用方法のまとめ (2024.9.8追加)

1.VLOOKUP関数の基本機能

VLOOKUPは一つの表の中のある文字列（または数字）と同じものを別の表から探し出してその表の中から（元の表にない）情報を取り出すことができます。この表は同じシート内でも構いませんし、別のシート、別のBookでも構いません。制約は

(1)取り出せる情報は相手の表の、探し出す文字列より右側にある必要がある

(2)基本的には取り出す情報がある列は決まっている　ことです

構文

= VLOOKUP（検索値,範囲, 列番号, 検索の型）

検索値と同じ値のものを範囲の中から探し出し、その表のn列目（=列番号）の値を表示する

　　検索の型は基本的に『FALSE』または『０』を使います。同じ意味として使われます。

範囲は列で指定しても、範囲の右上：左下を指定しても構いません。

少し煩雑になるのは他のシートまたは他のブックの（特定のシート）を参照する時の文法です

３つのケースについてまとめてみました

①範囲が同一シートにある場合　　セルの範囲そのまま　例　A:B 、A2:B20 など

②範囲が(同一Book)別シートにある場合　　

シート名!セルの範囲　　例　Sheet2!A:B 、Sheet2!A2:B20 など　

③範囲が別Bookにある場合　

’Bookの所在する場所[Book名]シート名'!セルの範囲

『'』『[』『]』『!』を使い分ける必要があります

例　=VLOOKUP(C9,'D:￥[単価表.xlsx]Sheet3'!$A:$B,2,0)

次に参照相手が登録されていなかった場合、登録されていたが表示すべき文字列が空白だった場合など

織り交ぜての使用例を紹介します。

①～⑩はそれぞれ実行された結果と、そのセルに入っている関数を表示しています。

④は該当するコードがなかった場合、⑤はその場合のエラー処理の一例です

⑥は参照した相手に商品名が記入されていなかった場合（文字列を表示すべき所『0』が表示されてしまう）

⑦は⑥に対する対策の一つです

2.VBAでVLOOKUPを実行する

VBAでは完全にVLOOKUPと同じ機能はありません。というより制約が多いのです。

また未登録データをメンテナンスしながら確かめるという作業には向いていません。

メリットは他の処理と合わせて自働化できる事、シートの容量を小さくできる事などです。

上記の表をD列の表記を全てマクロで実行させる例と、実行結果を示します。

VBAではVLOOKUPをそのまま使えないため、Application.WorksheetFunction.VLookup

メソッドを使用します

Sub TEST21()

Dim MaxRow As Long

Dim i As Long

Dim tbl As RANGE

Set tbl = Sheets("Sheet2").RANGE("A2:B1000")　　'参照するシートの範囲を定義する

Sheets("Sheet1").Select

MaxRow = Cells(Rows.Count, 2).End(xlUp).Row　

For i = 2 To MaxRow

Cells(i, "D") = "未登録!!"　　　　　　　　　　　　'参照ができなかった時は『未登録!!』を表示する

On Error Resume Next　　　　　　　　　　　　　'エラーが発生しても無視して実行する

Cells(i, "D") = Application.WorksheetFunction.VLookup(Cells(i, "C"), tbl, 2, 0)

Err.Clear

3.VLOOKUPの近似値機能を使う

最初にVLOOKUPの構文で『検索の型』は『FALSE』または『0』を使用すると述べました。

もし上記の例で『TRUE』または『1』を使用するとどうなるかというと

検索先に登録されていない、商品コード10003で商品の情報を検索すると、10004の商品名が表示されることになります。

これはどう考えても使えませんよね。

しかし、これが必要な場合もあります。それは

①　範囲で検索する場合

②　1対nの検索をする場合　です

①範囲で検索する場合

①の例として郵便・輸送料金の算出で重量から料金を求める場合、年齢で入場料金を決める場合などがあります。

下記は定形外郵便の料金表を使って郵便物の料金を求める関数を使用した表です。

『近似値機能』といっても探す範囲は『検索値以下の最大の値』となります。従って対応する料金表の作り方も少し工夫する必要が出てきます。

赤字部分の＄は固定位置の機能です。C3に入力した関数をコピーダウンした時に参照する表の位置がずれないようにするためにこのようにしました。

4.VLOOKUPで1対nの処理をする

給与のサブシステムで社員の扶養手当を算出するようなケースを考えてみます。

社員データの右に何人か分の扶養家族エリアを持っても可能ですが、情報や家族数が増えると煩雑になります。メンテナンス上は家族だけのシートを作成した方が楽なのです。

条件としてseqNOをシートの行数と同じにしておくことと、扶養者のシートを社員コード順に並べておく必要があります。

上から順にSheet1、Sheet2、Sheet3(計算結果）となります。

他の業務として部品展開などへの応用も考えています。

ここから先のマクロは扶養者データ側から社員シートをVLOOKUPすればすごく単純にできますが最終的にデータがm対nの結合、しかもSheet2が数千、数万件に上るデータの処理の利便性を目標にしているので、関心のない方は見る必要はありません。この種のマクロを使うと、かえって手間が掛かります。

部品展開穂処理への応用などを想定しています。

実務的にはそのような例は希かと思いますが、数百人規模の入院者のいる病院の食事の材料の調達や、工場の生産計画に基づいた部品展開(MRP)が対象となります。個人的にはその部分はACCESで実行した方がはるかに効率的なのですが、それはそれで面倒なので、VBAでできる限りのことをしてみましょう。

Sub TEST22()

Dim i As Long '社員シートのカウンター

Dim j As Long '扶養家族シートのカウンター

Dim k As Long '結果シートのカウンター

Dim MaxRow As Long

Dim Max2 As Long

Dim tbl As Range

Dim seq As Long

Dim 社員cd As Long

Dim 社員名 As String

Dim 扶養cd As Long

Dim 扶養名 As String

Dim 扶養手当 As Long

'シート３を事前にクリアーしておく

Sheets("Sheet3").Select

Sheets("Sheet3").Range("A1").CurrentRegion.Offset(1, 0).Clear

k = 2

Sheets("Sheet2").Select

Max2 = Cells(Rows.Count, 1).End(xlUp).Row

Set tbl = Sheets("Sheet2").Range("A2:B" & Max2) 'vlookupの検索範囲の定義

Sheets("Sheet1").Select

MaxRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To MaxRow '社員シートに対する処理

社員cd = Cells(i, 1)

社員名 = Cells(i, 2)

　seq = 2

On Error Resume Next

seq = Application.WorksheetFunction.VLookup(Cells(i, "A"), tbl, 2, 0)　'①

Err.Clear

Sheets("Sheet2").Select

j = seq

For j = seq To Max2　　'②

If 社員cd <> Cells(j, 1) Then Exit For　'③

扶養cd = Cells(j, 3) '以下Sheet3へ書き出す項目の編集

扶養名 = Cells(j, 4)

扶養手当 = Cells(j, 11)

If 扶養手当 <= 0 Then Exit For　　'扶養手当が０の時は何もSheet3へは記入しない

Sheets("Sheet3").Select

Cells(k, 1) = 社員cd

Cells(k, 2) = 社員名

Cells(k, 3) = 扶養cd

Cells(k, 4) = 扶養名

Cells(k, 5) = 扶養手当

k = k + 1

Sheets("Sheet2").Select

Next j

Sheets("Sheet1").Select

Next i

End Sub

解説　わかりずらい所を解説します。

①VLOOKUPで求める値が扶養家族の情報ではなくseqであること

⇒VLOOKUPではキー（この場合では社員番号）で照合できるのは照合先の表のキーから右側のセルの値です。社員コード1001で扶養家族のシートを参照した時に得ることができるのは赤文字で示した部分です。しかしそれがシート上のどの位置にあるかは解らないのです。従って、その次の行を探しにいくことができません。そこで（苦し紛れに）行位置と同じ値を持つseqをあらかじめ作成しておき、その値を１ずつ加算して同じ社員の扶養者の情報を順次求めているわけです。

②Sheet2をその最後まで読み続けるという文

途中で③の文でfor文を抜ける事を前提としていますが、同じ社員コードの扶養データが何行目まで続いているかが事前に解らないためこうしています。

少し詳しい方なら『do while 』文を使うかもしれません。その方が理解しやすいコードになります。しかし『do while 』文は行（i)を自動でカウントアップしないので　i = i + 1 の記述をする必要があります。これを忘れたり、位置が間違えていると永久ループしてしまうのであえて使いませんでした。

データの準備（Sheet2を社員コード別、扶養者コード別にソートし、行番号と同じになるようseqを記入する）が大変なのであまりおすすめできませんが、この基本を抑えておかないと応用が効かなくなりますので１対１以外のデータ照合（連結とも言います）にはこのような面倒な作業が伴います。

5.MATCHで1対nの処理をする

３．ではseqのメンテナンスが一手間多いと思われた方も多いと思います。

そこでVLOOKUPの代わりに『WorksheetFunction.Match』を使ってみます。

WorksheetFunctionはEXCEL関数の『MATCH』を（ほぼ）そのままVBAで使用するための接頭語（にょうなもの）です。

この構文はSheet1のある値がSheet2の何行目のセルにあるかを返してくれる関数です。文法は以下の通りです。

=MATCH(検索値, 検査範囲, [照合の種類])　照合の種類は　完全一致の　０　を使用します

このメソッドは検査範囲内に検索値と同じ値が何行目にあるか返してしてくれますがそれ以上のことは解りません。このメソッドを使用することによりseqを設定する必要はなくなります。ただしSheet2を社員コード別、扶養者コード別にソートすることは省略できません。

結果については上記と同じなので省略致します。

Sub TEST23()

Dim i As Long '社員シートのカウンター

Dim j As Long '扶養家族シートのカウンター

Dim k As Long '結果シートのカウンター

Dim MaxRow As Long

Dim Max2 As Long

Dim tbl As Range

Dim stcel As Long

Dim 社員cd As Long

Dim 社員名 As String

Dim 扶養cd As Long

Dim 扶養名 As String

Dim 扶養手当 As Long

'シート３を事前にクリアーしておく

Sheets("Sheet3").Select

Sheets("Sheet3").Range("A1").CurrentRegion.Offset(1, 0).Clear

k = 2

Sheets("Sheet2").Select

Max2 = Cells(Rows.Count, 1).End(xlUp).Row

Sheets("Sheet1").Select

MaxRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To MaxRow '社員シートに対する処理

社員cd = Cells(i, 1)

社員名 = Cells(i, 2)

Sheets("Sheet2").Select

stcel = 2

On Error Resume Next

stcel = WorksheetFunction.Match(社員cd, Range("A1:A" & Max2), 0)　　

Err.Clear

For j = stcel To Max2

If 社員cd <> Cells(j, 1) Then Exit For

扶養cd = Cells(j, 3)

扶養名 = Cells(j, 4)

扶養手当 = Cells(j, 11)

If 扶養手当 <= 0 Then Exit For

Sheets("Sheet3").Select

Cells(k, 1) = 社員cd

Cells(k, 2) = 社員名

Cells(k, 3) = 扶養cd

Cells(k, 4) = 扶養名

Cells(k, 5) = 扶養手当

k = k + 1

Sheets("Sheet2").Select

Next j

Sheets("Sheet1").Select

Next i

End Sub

6.扶養者がいない社員のリストへの追加(MATCHの使用)

３．4 では扶養者がいない社員のリストアップはされませんでした。

Sheet1の社員を追加した上でSheet3に扶養家族がいない社員を含めたリストを作成します。

Sub TEST23()

Dim i As Long '社員シートのカウンター

Dim j As Long '扶養家族シートのカウンター

Dim k As Long '結果シートのカウンター

Dim MaxRow As Long

Dim Max2 As Long

Dim stcel As Double

Dim 社員cd As Long

Dim 社員名 As String

Dim 扶養cd As Long

Dim 扶養名 As String

Dim 扶養手当 As Long

'シート３を事前にクリアーしておく

Sheets("Sheet3").Range("A1").CurrentRegion.Offset(1, 0).Clear

k = 2 'Sheet3へ書き出す行の初期設定

' Sheet2 (扶養家族シート) の　最大行数を求める　①

Sheets("Sheet2").Select

Max2 = Cells(Rows.Count, 1).End(xlUp).Row

' Sheet2 (社員シート) の　最大行数を求める　②

Sheets("Sheet1").Select

MaxRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To MaxRow '社員シートに対する処理（大ループ）

社員cd = Cells(i, 1)

社員名 = Cells(i, 2)

Sheets("Sheet2").Select

On Error Resume Next

'社員コードで同一社員コードを持つ扶養家族の行位置を求める　　①

stcel = 1

stcel = WorksheetFunction.Match(社員cd, Range("A1:A" & Max2), 0)

Err.Clear

'扶養加増がいなかった場合の処理（社員コードと名前だけをSheet3に書き出す

If 社員cd <> Cells(stcel, 1) Then　　’②　

Sheets("Sheet3").Select

Cells(k, 1) = 社員cd

Cells(k, 2) = 社員名

Cells(k, 3) = ""

Cells(k, 4) = ""

Cells(k, 5) = ""

k = k + 1

GoTo stp1

End If

'小ループ　同一社員の扶養者をSheet2の終了まで繰り返す

For j = stcel To Max2

'Sheet2を順次探す内社員コードが同一でない扶養者が現れたら

'処理を中断する（Shee1に戻って次の社員の処理をする

If 社員cd <> Cells(j, 1) Then Exit For

扶養cd = Cells(j, 3)

扶養名 = Cells(j, 4)

扶養手当 = Cells(j, 11)

If 扶養手当 <= 0 Then GoTo stp0 '扶養手当がなければ次の家族探す

Sheets("Sheet3").Select

Cells(k, 1) = 社員cd

Cells(k, 2) = 社員名

Cells(k, 3) = 扶養cd

Cells(k, 4) = 扶養名

Cells(k, 5) = 扶養手当

k = k + 1

Sheets("Sheet2").Select

Next j

'小ループの終了

stp1:

Sheets("Sheet1").Select

Next i

'大ループの終了

Sheets("Sheet3").Select

End Sub

解説　①Sheet1の社員コードでSheet2の社員コードを探します。対応するデータがシート上になければ

stcelには何も書き込まれませんから、事前にセットした　1 がはいります

②Sheet1の社員コードと比較されるのはSheet2の　cells(1,1) = "社員コード"なので不一致となりSheet3へ社員コードと名前を書き込む処理となります。

全体に分岐やシートのチェンジが多く、あまりよい例ではありませんがセルの値と、比較するセルの位置を求めようとするとこんなに煩雑な手続きになってしまいました。エラーコードで分岐する方法も考えましたが、想定外のエラーコードが発生した場合の処理が難しくなります。

次にもう少しVBAらしい処理を紹介したいと思います。

7.扶養者がいない社員のリストへの追加(MATCHの使用その２)

ここでは扶養者のいる社員といない社員を別々に扱う形で処理をします。

できるだけ分岐を少なくする(ifを使わない）方法をとります。

考え方を先に説明します。

(1)Sheet2をを社員コード別扶養者コード別にソートする。

(2)Sheet3をSheetの最後からシートの先頭に向かって扶養者数の小計を求めて社員コードが変わるタイミングで扶養者数を書き込む。

(3)Sheet3に必要な列をコピーする、社員名をセットする列は空けておく

(4)Sheet1に扶養者数の書き込まれている先頭の行数を書き込む列と扶養者数を入れる列を用意する

(5)Sheet1に上記２種類のデータを書き込む

(6)扶養者数>0 の社員に関して(5)に従って社員コードと社員名を、扶養者の数だけSheet3に書き込む

(7)扶養者のいない社員のデータをSheet3に書き込む

長くなりすぎるので高速化のための

　　　Application.ScreenUpdating = False

　　　Application.Calculation = xlCalculationManual　は省略しています

Sub TEST25()

Dim MaxRow1 As Long 'Sheet１最大行

Dim MaxRow2 As Long 'Sheet2最大行

Dim RANGE1 As String

Dim old As Long

Dim i, j As Long

Dim cnt As Long

Dim RANGEA As Range '特定シートの特定範囲を定義する方法(1)

Dim STCEL As Long

'Sheet3 を初期クリアーする

Worksheets("Sheet3").Range("A2:F1000").Clear

Sheets("Sheet2").Select

'Sheet2を社員コード別扶養者コード別にソートする

Range("A1").Sort Key1:=Range("A1"), Order1:=xlAscending, _

Key2:=Range("C1"), Order2:=xlAscending, Header:=xlYes

'Sheet2 の社員毎の扶養者数を求める

MaxRow2 = Cells(Rows.Count, 1).End(xlUp).Row

RANGE1 = "L1:L" & MaxRow2

Range(RANGE1).ClearContents　

Range("L1") = "扶養者数"

cnt = 1

old = Cells(MaxRow2, "A")

For i = MaxRow2 To 2 Step -1

If old <> Cells(i, 1) Then

j = i + 1

Cells(j, "L") = cnt - 1

cnt = 2

Else

cnt = cnt + 1

End If

old = Cells(i, 1)

Cells(j, "L") = cnt - 1

'Sheet2をSheet3へ列ごとコピーする－高速化のためSheet3をselectしない方法

Range(Cells(1, "A"), Cells(10000, "A")).Copy

Sheets("Sheet3").Cells(1, "A").PasteSpecial Paste:=xlPasteAll '

Application.CutCopyMode = False

Range(Cells(1, "C"), Cells(10000, "D")).Copy

Sheets("Sheet3").Cells(1, "C").PasteSpecial Paste:=xlPasteAll '

Application.CutCopyMode = False

Range(Cells(1, "K"), Cells(10000, "L")).Copy

Sheets("Sheet3").Cells(1, "E").PasteSpecial Paste:=xlPasteAll '

Application.CutCopyMode = False

'Sheet1の計算エリア初期化

Sheets("Sheet1").Select

Range("H1") = "扶養者数"

Range("I1") = "扶養者先頭行"

Range("H1:I10000").ClearComments

'MATCH関数の参照範囲を定義する

Set RANGEA = Sheets("Sheet3").Range("A1:A10000")　　'(1)

MaxRow1 = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To MaxRow1

'Sheet3の扶養者数がある行を求める

STCEL = 0

On Error Resume Next

STCEL = WorksheetFunction.Match(Cells(i, "A"), RANGEA, 0)

Err.Clear

Cells(i, "I") = STCEL

'扶養者数をSheet1のF列に記入する（両方のセル位置が分かっている時は下記

　のような代入式にすれば、SheetをSelectし直す必要がなく高速化につながる

If STCEL <> 0 Then

Sheets("Sheet1").Cells(i, "H").Value = Sheets("Sheet3").Cells(STCEL, "F").Value　'(2)

End If

For i = 2 To MaxRow1

cnt = Cells(i, "I")

If cnt <> 0 Then

Sheets("Sheet3").Cells(cnt, 2).Value = Sheets("Sheet1").Cells(i, 2).Value　'(2)

End If

j = MaxRow2 + 1

For i = 2 To MaxRow1

cnt = Cells(i, "I")

If cnt = 0 Then

Sheets("Sheet3").Cells(j, 1).Value = Sheets("Sheet1").Cells(i, 1).Value　'(2)

Sheets("Sheet3").Cells(j, 2).Value = Sheets("Sheet1").Cells(i, 2).Value　'(2)

j = j + 1

End If

Sheets("Sheet3").Select

j = j - 1

Range("A1:E" & j).Borders.LineStyle = True

End Sub

解説

(1)　セルを参照する場合の Range とオブジェクト変数の　Rangeの違いについて

たいへん紛らわしいのですが　Dim ～　as　Range で定義すると通常のRangeとは異なった機能となります

①　通常のRangeはSelectしているシートの範囲しか規定できませんが、オブジェクト変数を使用すると

現在Selectしているシートを定義できます。このため他のシートを参照する場合のVlookupやMatchとたいへん相性良く使えます

②　Range変数に変数（具体的な範囲）を代入するためには = ではなく　set "Range" = 範囲となります

具体的には次のような使用方法の違いがあります

Range("A1:C5") = "AAA" ⇒　A1とC5で囲まれた範囲を　"AAA" とする

Set RANGEA = .Range("A1:C5") ⇒ RANGEA の範囲を規定する

RangeA = "AAA"　　　　　　　 ⇒ RANGEA で規定された範囲に"AAA"を代入する

上の１行目で済ませることをわざわざ下の２行で記述するのは無駄ですから、やはり

『参照範囲』の定義に使うのが一般的です

(2) Sheets("Sheet1").Cells(i, "H").Value = Sheets("Sheet3").Cells(STCEL, "F").Value　は

下記の表現もできます

Sheets("Sheet3").select

Cells(i, "H").copy

Sheets("Sheet1").Range("STCEL,"F").PasteSpecial Paste:=xlPasteValues

Sheets("Sheet1").select

しかしSheetを２回もSelectし直すことは大変なタイムロスとなりますので避けました。

8.VLOOKUPもMATCHも使わない（連想配列=Dictionary)

今まで1件のデータに対して複数の参照方法を４～７で紹介してきましたが考え方が難しくなってしまいます（私がひねくれているせいだけではありません）。Office Proをお持ちなら、ここだけAccessに頼った方がよいかもしれません。

でもそこはVBAにこだわりたい。なぜならリソース管理が簡単だから。そこで今まで拘っていたことを一つ捨てます。それは『参照元』『参照先』『参照結果（抽出結果）』を別シート管理することです。リソース管理としては別シートでも、演算するときだけ同一シートに配置して、演算結果もたとえば『20001行以降』とか設定すればシートチェンジのタイムロスを随分と節約できるのではないかと。

そして、『参照先の行位置が分からないVLOOKUP』も『参照先の行位置は分かっても参照先の事前ソートが必要でブレークポイントを自分で判断しなければいけないMACH』も潔く諦めて、手作業でやってみてはどうかと思いつきました。参照元１件読み込む毎に参照先を全件参照したらどうなるかを試していきたいと思います。無謀ではありますがどのくらい時間が掛かるか検証することで、何件くらいのデータなら実用性があるか見えてくることもあるはずです。

2024.9.16追記

連想配列について10.dictionary使用方法のまとめを追記しましたのでそちらも参考に願います。

テストデータの作成

処理速度の評価をするため、データ件数50,000件用意しました。売上データと想定して、売上件数50,000件、商品コード2,000件。その商品コードで商品マスタを検索して商品名を売上データに書き込むという前提です。

実行方法

(1)WorksheetFunctionを使用して別シートの商品テーブルから商品名を取得する（基準速度の算出）

(1)のモジュール

(2)別シートの商品テーブルを同一シートにコピーして実行する。

(2)のモジュール

(3)商品テーブルを全て配列にコピーして、売上データの商品コードで１件ずつ商品テーブルの入った配列を検索する

(3)のモジュール

(4)(3)と同様に商品テーブルを配列に全てコピーして、Application.WorksheetFunction.Matchでその配列を検索する。 (4)のモジュール

(5)(1)と同じようにWorksheetFunctionを使用するが、求めらた商品名を配列に転送して、処理の最後に売上データに書き込む。 (5)のモジュール

(6)Dictionary 機能を使う（結果的にこれが最速でした） (6)のモジュール

テストデータ

商品名は実行前は空白

参照するシート

（1)のモジュール

Sub TEST29()

Application.ScreenUpdating = False 'ディスプレイ出力抑止

Dim Mains As Worksheet

Dim Subs As Worksheet

Dim Srange As Range

Dim Mkey As String

Dim Max1, Max2 As Long

Dim i As Long

Sheets("Sheet1").Select

Set Mains = Sheets("Sheet1")

Max1 = Cells(Rows.Count, "A").End(xlUp).Row

Sheets("Sheet2").Select

Set Subs = Sheets("Sheet2")

Max2 = Cells(Rows.Count, "A").End(xlUp).Row

Set Srange = Range(Subs.Cells(2, 1), Subs.Cells(Max2, 2))

Sheets("Sheet1").Select

For i = 2 To Max1

Mkey = Mains.Cells(i, 2)

Mains.Cells(i, 3) = ""

On Error Resume Next

Mains.Cells(i, 3) = WorksheetFunction.VLookup(Mkey, Srange, 2, False)

Err.Clear

Application.ScreenUpdating = True 'ディスプレイ出力再開

End Sub

実行結果　3回実行して　平均　32.6秒

（2)のモジュール

Sub TEST30()

Application.ScreenUpdating = False 'ディスプレイ出力抑止

Dim Mains As Worksheet

Dim Subs As Worksheet

Dim Srange As Range

Dim Mkey As String

Dim Max1, Max2 As Long

Dim i As Long

Dim ST_TIME As Double, ED_TIME, PC_TIME As Double

Sheets("Sheet1").Select

Set Mains = Sheets("Sheet1")

Max1 = Cells(Rows.Count, "A").End(xlUp).Row

Sheets("Sheet2").Select

Columns("A:B").Copy Sheets("Sheet1").Columns("E")

Sheets("Sheet1").Select

Max2 = Cells(Rows.Count, "E").End(xlUp).Row

Set Srange = Range(Cells(2, 5), Cells(Max2, 6))

For i = 2 To Max1

Mkey = Mains.Cells(i, 2)

Mains.Cells(i, 3) = ""

On Error Resume Next

Mains.Cells(i, 3) = WorksheetFunction.VLookup(Mkey, Srange, 2, False)

Err.Clear

Application.ScreenUpdating = True 'ディスプレイ出力再開

End Sub

赤字の部分がモジュール１と大きく変わっています

３回実行して平均は16.6秒です。やはり検索先のテーブルが同一シートにあると実行速度は倍近く上がりました。

（3)のモジュール

Sub TEST31()

Application.ScreenUpdating = False 'ディスプレイ出力抑止

Dim Mains As Worksheet

Dim Subs As Worksheet

Dim Srange As Range

Dim Mkey As String

Dim Max1, Max2 As Long

Dim i As Long

Sheets("Sheet1").Select

Set Mains = Sheets("Sheet1")

Max1 = Cells(Rows.Count, "A").End(xlUp).Row

Dim j As Long '

Dim SCD() As String '商品コードのテーブル

Dim SNAME() As String '商品名のテーブル

Worksheets("Sheet2").Select

Max2 = Cells(Rows.Count, "A").End(xlUp).Row

'配列テーブルの項目数再定義

ReDim SCD(Max2 - 2)

ReDim SNAME(Max2 - 2)

' プログラム開始時に一気に読み込む

For i = 0 To Max2 - 2

SCD(i) = Cells(i + 2, "A")

SNAME(i) = Cells(i + 2, "B")

Cells(i, 3) = ""

For i = 2 To Max1

For j = 0 To Max2 - 2

If Cells(i, 2) = SCD(j) Then

Cells(i, 3) = SNAME(j)

Exit For '検索終了

End If

Worksheets("Sheet1").Select

ED_TIME = Timer

Application.ScreenUpdating = True 'ディスプレイ出力再開

End Sub

赤字の部分がこのモジュールの特徴です。商品テーブルを１件ずつ照合しています。

３回実行して平均は145秒です。商品テーブルの件数が多すぎたようです。商品の件数が100件程度なら十分速い速度が出せたと思います。

（4)のモジュール

Sub TEST32()

Application.ScreenUpdating = False 'ディスプレイ出力抑止

Dim Mains As Worksheet

Dim Subs As Worksheet

Dim Srange As Range

Dim Mkey As String

Dim Max1, Max2 As Long

Dim i As Long

Sheets("Sheet1").Select

Set Mains = Sheets("Sheet1")

Max1 = Cells(Rows.Count, "A").End(xlUp).Row

Dim j As Long '

Dim SCD() As String '商品コードのテーブル

Dim SNAME() As String '商品名のテーブル

Worksheets("Sheet2").Select

Max2 = Cells(Rows.Count, "A").End(xlUp).Row

'配列テーブルの項目数再定義

ReDim SCD(Max2 - 2)

ReDim SNAME(Max2 - 2)

' プログラム開始時に一気に読み込む

'特殊番号のシートをセレクトする

For i = 0 To Max2 - 2

SCD(i) = Cells(i + 2, "A")

SNAME(i) = Cells(i + 2, "B")

For i = 2 To Max1

Cells(i, 3) = ""

j = WorksheetFunction.Match(Cells(i, 2), SCD, 0)

If IsError(j) Then

MsgBox Cells(i, 2) & " 未登録です"

Else

Cells(i, 3) = SNAME(j - 1)

End If

End Sub

赤字の部分がこのモジュールの特徴です。商品テーブルを全て配列に読み込んだ後WorksheetFunction.Matchで検索しています。

３回実行して平均は62.1秒。配列検索の割には通常の WorksheetFunction.VLookupの２倍の時間が掛かっています。

事前に商品テーブルをキー順にソートしておく必要もあり、あまり使い勝手がいいとは思えません。

（5)のモジュール

Sub TEST33()

Application.ScreenUpdating = False 'ディスプレイ出力抑止

Dim Mains As Worksheet

Dim Subs As Worksheet

Dim Srange As Range

Dim Mkey As String

Dim Max1, Max2 As Long

Dim i As Long

Sheets("Sheet1").Select

Set Mains = Sheets("Sheet1")

Max1 = Cells(Rows.Count, "A").End(xlUp).Row

Dim SNAME() As String '品番コードのテーブル

ReDim SNAME(Max1 - 2)

Sheets("Sheet2").Select

Set Subs = Sheets("Sheet2")

Max2 = Cells(Rows.Count, "A").End(xlUp).Row

Set Srange = Range(Subs.Cells(2, 1), Subs.Cells(Max2, 2))

Sheets("Sheet1").Select

For i = 2 To Max1

Mkey = Mains.Cells(i, 2)

On Error Resume Next

SNAME(i - 2) = ""

SNAME(i - 2) = WorksheetFunction.VLookup(Mkey, Srange, 2, False)

Err.Clear

Range(Cells(2, 3), Cells(Max1, 3)) = WorksheetFunction.Transpose(SNAME)

Application.ScreenUpdating = True 'ディスプレイ出力再開

End Sub

赤字の部分がこのモジュールの特徴です。(1)のモジュールとほとんど同じですが、検索語の商品名を全て配列に格納して最後に１回だけ売上データに書き込みしています。特に配列からシートへの連続した書き込にWorksheetFunction.Transpose(SNAME)を使っています。３回実行した平均速度は（以外にも）8.18秒でした。

Excelシートからの読み出しと書き込みの速度差が大きいことが認識でできました。

（6)のモジュール

このモジュールを動かすためには、VBA画面のツールメニュー→参照設定を選び、参照設定ダイアログで「Microsoft Scripting Runtime」にチェックを付けます。

Sub TEST34()

Dim mains As Worksheet

Dim Subs As Worksheet

Dim Srange As Range

Dim Mkey As String

Dim Max1, Max2 As Long

Dim i, k As Long

Dim dict1 As Dictionary

Set dict1 = New Dictionary

Application.ScreenUpdating = False 'ディスプレイ出力抑止

Sheets("Sheet1").Select

Set mains = Sheets("Sheet1") '伝票シート定義

Max1 = Cells(Rows.Count, "A").End(xlUp).Row '最大行算出

Dim SNAME() As String '商品名を格納する配列

ReDim SNAME(Max1 - 2)

Sheets("Sheet2").Select ' 商品シート

Set Subs = Sheets("Sheet2")

Max2 = Cells(Rows.Count, "A").End(xlUp).Row '最大行算出

Set Srange = Range(Subs.Cells(2, 1), Subs.Cells(Max2, 2))

'ディクショナリーへの格納

For k = 2 To Max2

If dict1.Exists(Srange(k, 1).Value) = False Then

dict1.Add Key:=Srange(k, 1).Value, Item:=Srange(k, 2).Value

End If

For i = 2 To Max1

SNAME(i - 2) = ""

On Error Resume Next

' 　商品コードから商品名を検索する

SNAME(i - 2) = dict1.Item(CStr(mains.Cells(i, 2)))

Err.Clear

Application.ScreenUpdating = True 'ディスプレイ出力再開

End Sub

３回実行した平均速度は0.54秒で最速でした。

赤字の部分がこのモジュールの特徴です。(5)で紹介した検索結果の配列への格納も実施しています。

Dictionaryは制約が多くデバッグもしずらいですが、大量データを扱う時は選択肢の一つとして外せないでしょう。

9.dictionaryを使って多項目を扱う

とはいってもdictionaryそのものには、キーと項目の2つしか扱えません。項目に配列も使えません。ではどうするかというと普通の配列と抱き合わせて使います。しかもそれは2次元以上の配列となります。

たとえば上記に商品コードと商品名のテーブルを扱っていますがが、これに品種コード、生産場所（発注先）コードを

追加したとします。

その場合 8-(6) では　dictionary key ⇒ 商品コード　Item ⇒ 商品名　でしたが

多項目を扱う場合　　　　　　 key ⇒ 商品コード　item ⇒ seq No とします。

　　そして連携する配列として　tbl1(商品件数,要素数）を作ります。要素数は　1.商品名 2.品種コード 3.生産場所コード

　　　　　　　　　　　　　　　の2次元配列を作るわけです。

tbl1にアクセスする場合はまず dictionaryを参照してそのseq番号を取得し、その番号で連携する配列を参照するという2度手間をとるわけです。コーディングの手間もテストも大変ですがvlookupと比較すると100倍以上の高速化が見込めます。

テストデータ

Sub TEST35()

Dim mains As Worksheet

Dim Subs As Worksheet

Dim Mkey As String

Dim Max1, Max2 As Long

Dim i, j, k, seq As Long

Dim dict1 As Dictionary

Dim D_tbl() As Variant

Dim S_tbl() As Variant '商品名を格納する配列

Application.ScreenUpdating = False 'ディスプレイ出力抑止

Set dict1 = New Dictionary

Set mains = Sheets("Sheet1") '伝票シート定義

Max1 = mains.Cells(Rows.Count, "A").End(xlUp).Row '最大行算出

ReDim D_tbl(Max1 - 2, 3) '伝票シートを丸ごと入れる配列の数を再定義します

Set Subs = Sheets("Sheet2") ' 商品シート

Max2 = Subs.Cells(Rows.Count, "A").End(xlUp).Row '最大行算出

ReDim S_tbl(Max2 - 2, 3) '商品シートを丸ごと入れる配列の数を再定義します

'商品コードをディクショナリーへ格納し、同時にそれと連携する配列（S_tbl)へ商品の情報を格納します

For k = 2 To Max2

j = k - 2

If dict1.Exists(Subs.Cells(k, 1).Value) = False Then

dict1.Add Key:=Subs.Cells(k, 1).Value, Item:=j　'①

S_tbl(j, 0) = Subs.Cells(k, 2) '商品シートをそのままのイメージでs_tblに格納します

S_tbl(j, 1) = Subs.Cells(k, 3)

S_tbl(j, 2) = Subs.Cells(k, 4)

End If

j = i - 2

' S_tbl(i - 2) = ""

On Error Resume Next

' 　商品コードからその商品の情報が格納されている　S_tblの指標を求めます

seq = dict1.Item(CStr(mains.Cells(i, 2)))　'②

'商品の情報を　伝票シート（のイメージの）配列に格納します

D_tbl(j, 0) = S_tbl(seq, 0)

D_tbl(j, 1) = S_tbl(seq, 1)

D_tbl(j, 2) = S_tbl(seq, 2)

Err.Clear

Range(mains.Cells(2, 3), Cells(Max1, 5)) = D_tbl

Application.ScreenUpdating = True 'ディスプレイ出力再開

End Sub

①連想連想記憶（dictionary)には商品に関する具体的な情報は何も保存しません。その代わり商品シートと同じイメージの配列（S_tbl)の何番目にその商品の情報が入っているか、その配列の指標を記憶します

②商品コードで連想配列を検索して、商品の情報が入っている　S_tblの指標を求めます。

３回実行した平均速度は0.98秒でした。

更に大きなデータを扱うとなると、あとはメモリの大きさとの相談となります。（Excelの64bit化も）

10.dictionary使用方法のまとめ

ここでは別のデータを使って以下のことを説明していきます

　10-1　なぜ連想配列を使うの？必要なの？

　10-2　連想配列の仕組みと設定（文法）

　10-3　Itemに参照したい項目をひとつだけ設定する場合

　10-4　Itemに参照したいシートの行番号を入れる場合

　10-5　Itemと配列を連動させる場合(行数固定)

　10-6　Itemと配列を連動させる場合(行数変動)

　10-7　Itemと配列を連動させて、配列側で集計処理をする場合

　10-8　クラス変数を用いて複数項目をオブジェクトにセットしてそれをItemに入れる

　10-9　クラス変数の中に配列（みたいなもの）→ Collection　を設ける

　10-1　なぜ連想配列を使うの？必要なの？

　　連想配列が必要なケースは少ないです。あえてリストアップすれば以下のようなケースかと思います。

　　①高速で検索処理したい。

　　②高速で集計処理したい。（①②どちらもApplication.ScreenUpdating = Falseなどを使っても効果が不十分な場合）

　　③Matchの使用を避けたい

　　　VBAは特定のデータを探すとき(1)Matchなどを使って、その行が何行目か (　m 行目にあったとします）　

　　 (2)仕様上必要なデータが何列目にあるか確認する( n　列目だとします）

　　　　　　　　　　　　　　　　　　(3)欲しいデータの所在はCells(m,n)にあることがわかります

　　　このプロセス（慣れても）結構面倒です。またMatchは引数の設定間違えてもエラー吐かなかったりするのでデバッグに

　　　手間取ったりします。

　　④他の人の書いたソースコードを理解したり、修正する必要がある。　　

　10-2　連想配列の仕組みと設定（文法）

　　連想配列は記憶が目的の配列ではなく、検索（あるいは参照とか取得）のための便宜的な機能です。

　　連想配列はKeyとItemの2項目しか持てません。しかも明示的にコード作成上keyやItemを使うことはできません。　　

　　2項目しか使えないのに、それは使えないというのはおかしな話ですね。実は書く場所によってそれらは決まってしまう、

　　というより決められた場所にしか書けない。そのルールに従えば自動的に、その変数にセットされます。

　　連想配列の文法

　　①連想配列の宣言

　　　方法1:VBA画面のツールメニュー→参照設定を選び、参照設定ダイアログで「Microsoft Scripting Runtime」にチェックを付ける。

　　　　　本文で以下の宣言をする。

　　　　　　　Dim dict1 As Dictionary (dict1は変数名なので自由に設定できます）　　　　　

　　　　　　　Set dict1 = New Dictionary

　　　方法2: 本文で以下の宣言をする。

　　　　　　Dim dict1 As Object

　　　　　Set dict1 = CreateObject("Scripting.Dictionary")　こちらの方が良いと思うようになりました。人それぞれです。

　　　②連想配列への追加 - 連想配列は重複キーを認めません。従って、そのキーがすでに連想配列にあるかどうか確認して追加します。

　　　　　 If dict1.Exists(Cells(i, 1).Value) = False Then 'もし連想配列にすでに登録されているキーがなければ

　　　dict1.Add Cells(i, 1).Value, Cells(i, 2).Value　'追加する　構文としては　連想配列名,Add keyの値、itemの値です

　　　End If

Cells(i,1)とかは処理によって置き換えます。セルの場合必ず .Valueを追記します。変数の場合は必要ありません。

　　　　　　Cells(i,1)　は内部的には　dict1.keys　に書き込まれ Cells(i,2) は dict1.Items に書き込まれます。

　　　③連想配列の呼び出し

　　　　　・keyでItemを呼び出す方法。

　　　　　　 If Not dict1.Exists(input1) = False Then 　　'input1は変数。この位置に書くことで　keyであることを示します。

　　　　　MsgBox dict1(input1)　　　'dict1(変数)でそれはkeyに対応するItemであると決まっています。

　　　　　End If

　　　　　　If文はなくても動くのですが、この手続きを踏まないと、参照したものが未登録の時、keyが追加されてしまうことがあります。

・連想配列全体を表示する方法 key　と　item をスペースで区切って表示します。デバッグの時に使用します。

　　　　　　Dim IT As Variant

　　　　　For Each IT In dict1.keys

　　　　　　MsgBox IT & " " & dict1(IT)

Range("A2:F2") = dict1.items などでシートに直接書き込むことも可能です。　

10-3　Itemに参照したい項目をひとつだけ設定

　　　する場合

これからしばらく右のテストデータを例に

コードを記述します。

以下のコードはデータ処理ではなく、データ処理の準備です。

メインの処理をする前に右のデータを事前に連想配列に

組み込んで後の処理を高速化、簡略化するためのものです。

　　Sub Dict1Test1()　　　’この方法だと社員番号で参照できるのは聯例だけになってしまいます

　　Dim i As Long

　　Dim Dict1 As Object

　　Set Dict1 = CreateObject("Scripting.Dictionary")

　　For i = 2 To 6

　　If Dict1.Exists(Cells(i, 1).Value) = False Then 'もし連想配列にすでに登録されているキーがなければ

　　Dict1.Add Cells(i, 1).Value, Cells(i, 2).Value

　　End If

　　'全ての社員番号と年齢を表示する（デバックの時使用)

　　For Each IT In Dict1.keys

　　MsgBox IT & " " & Dict1(IT)

　　Dim input1 As String

　　input1 = "A02"

　　If Not Dict1.Exists(input1) = False Then

　　MsgBox Dict1(input1) & " 社員番号 A02 の年齢"

　　End If

　　End Sub

10-4　Itemに参照したいシートの行番号を入れる場合

　次は各社員番号の行が何行目にあるか記憶させ、複数の情報（年齢、社員番号）を参照可能にする方法です。

　Sub Dict1Test2()

Dim i As Long

Dim Dict1 As Object

Set Dict1 = CreateObject("Scripting.Dictionary")

For i = 2 To 6

If Dict1.Exists(Cells(i, 1).Value) = False Then 'もし連想配列にすでに登録されているキーがなければ

Dict1.Add Cells(i, 1).Value, i 'itemにセットするのはそのkeyのデータが書かれている行数

End If

'全ての社員番号と年齢を表示する（デバックの時使用)

For Each IT In Dict1.keys

MsgBox IT & " " & Cells(Dict1(IT), 2) & " " & Cells(Dict1(IT), 3) 'Dict1(IT)はその社員番号の書かれている行

Dim input1 As String

input1 = "A02"

If Not Dict1.Exists(input1) = False Then

MsgBox input1 & "　の年齢と名前 " & Cells(Dict1(input1), 2) & " " & Cells(Dict1(input1), 3)

End If

End Sub

10-5　Itemと配列を連動させる場合(行数固定)　

参照することになるシート上の情報を別の配列に入れて、そのインデックス（行）と連想配列のItemを連動させる方法です。

配列のサイズはシートの行数を読み取って、最初に決めてしまいます。

Sub Dict1Test3()

Dim i As Long, Max1 As Long, k As Long

Dim Dict1 As Object

Dim Ary1()

Set Dict1 = CreateObject("Scripting.Dictionary")

Max1 = Cells(Rows.Count, "A").End(xlUp).Row '最大行算出

ReDim Ary1(Max1 - 2, 1) '配列の資料は0から開始される

For i = 2 To Max1

If Dict1.Exists(Cells(i, 1).Value) = False Then 'もし連想配列にすでに登録されているキーがなければ

Dict1.Add Cells(i, 1).Value, i - 2 'itemにセットするのはAry1の指標

Ary1(i - 2, 0) = Cells(i, 2).Value

Ary1(i - 2, 1) = Cells(i, 3).Value

End If

'全ての社員番号と年齢を表示する（デバックの時使用)

For Each IT In Dict1.keys

MsgBox IT & " " & Ary1(Dict1(IT), 0) & " " & Ary1(Dict1(IT), 1) 'Dict1(IT)はAry1の指標

Dim input1 As String

input1 = "A02"

If Not Dict1.Exists(input1) = False Then

MsgBox input1 & "　の年齢と名前 " & Ary1(Dict1(input1), 0) & " " & Ary1(Dict1(input1), 0)

End If

End Sub

10-6　Itemと配列を連動させる場合(行数変動)

これは配列のサイズを可変にする方法です。特定の部門の社員だけ対象にするというようなケースです。

行数のiと対象件数のkと指標をふたつ持つ持つこと。Redim文がフープの中に入ること。配列の大きさを都度変えること（動的配列）

そして動的配列を使うときは行と列を逆転させなければいけないこと、など急に難易度は上がります。VBAの文法制約との闘いでもあります。

Sub Dict1Test4()

Dim i As Long, Max1 As Long, k As Long

Dim Dict1 As Object

Dim Ary1()

Set Dict1 = CreateObject("Scripting.Dictionary")

Max1 = Cells(Rows.Count, "A").End(xlUp).Row '最大行算出

' ReDim Ary1(Max1 - 2, 1) '配列の資料は0から開始される

k = -1

For i = 2 To Max1

If Dict1.Exists(Cells(i, 1).Value) = False Then 'もし連想配列にすでに登録されているキーがなければ

　　　'ここに全ての社員ではなく特定部門の社員に限るような条件式が入ると想定

k = k + 1

Dict1.Add Cells(i, 1).Value, k 'itemにセットするのはAry1の指標

ReDim Preserve Ary1(1, k)

Ary1(0, k) = Cells(i, 2).Value　　　　'配列の大きさを変えるときは、列方向しか変えられない

Ary1(1, k) = Cells(i, 3).Value

End If

'全ての社員番号と年齢を表示する（デバックの時使用)

For Each IT In Dict1.keys

MsgBox IT & " " & Ary1(0, Dict1(IT)) & " " & Ary1(1, Dict1(IT)) 'Dict1(IT)はAry1の指標　行と列が逆転

Dim input1 As String

input1 = "A02"

If Not Dict1.Exists(input1) = False Then

MsgBox input1 & "　の年齢と名前 " & Ary1(0, Dict1(input1)) & " " & Ary1(1, Dict1(input1))

End If

End Sub

10-7　Itemと配列を連動させて、配列側で集計処理をする場合

今までは参照される側の連想配列の、事前準備でしたが、ここでは連想配列と配列を使った集計です。社員番号別作業区分別集計とか実務でもありそうですが、ここでは作業区分別集計にとどめおきます。

今までは配列は追加だけでしたが、今回は上からデータを読み込んで、初めての作業区分⇒配列を追加して時間をセット。2回目以降にその作業区分が現れたら、前回の区分の作業時間に加算するという考え方です。

Sub Dict1Test5()

Dim i As Long, Max1 As Long, k As Long, m As Long

Dim Dict1 As Object

Dim Ary1()

Set Dict1 = CreateObject("Scripting.Dictionary")

Max1 = Cells(Rows.Count, "A").End(xlUp).Row '最大行算出

' k = -1

For i = 2 To Max1

If Dict1.Exists(Cells(i, 3).Value) = False Then 'もし連想配列にすでに登録されているキーがなければ

k = k + 1

Dict1.Add Cells(i, 3).Value, k 'itemにセットするのはAry1の指標

ReDim Preserve Ary1(1, k)

Ary1(0, k) = Cells(i, 3).Value '作業区分

Ary1(1, k) = Cells(i, 4).Value '作業時間

Else 'すでに区分が登録されていたときは加算

Ary1(1, Dict1(Cells(i, 3).Value)) = Ary1(1, Dict1(Cells(i, 3).Value)) + Cells(i, 4).Value

End If

'全ての区分の作業時間を表示する

For Each IT In Dict1.keys

MsgBox IT & " " & Ary1(1, Dict1(IT)) 'Dict1(IT)はAry1の指標

Dim input1 As Variant

input1 = 3

If Not Dict1.Exists(input1) = False Then

MsgBox input1 & "　の作業時間 " & Ary1(1, Dict1(input1))

End If

End Sub

10-8　クラスモジュールを用いて複数項目をオブジェクトにセットしてそれをItemに入れる

連想配列のItemに変数を一つしか選べないことから、参照で複数の項目を取得したいときには、シートを見に行ったり、別の配列を作ったりと、それなりに大変です。集計の仕方によっては連想配列は（配列と連携することにより）ピボッドテーブル並みの高速処理が可能になりますが一般的な件数での使用（データ1000件くらいまで）では10-4のシート参照で十分かと思います。（あるいはMatch命令）

クラスモジュールもひとつの考え方として紹介します。10-8ではクラスモジュールをクラス変数と割り切って使用します。

操作対象は10-3の表です。10-5または10-6を別の配列を作らずに同様のことを実行したいと思います。

方法はItemにセットするのをStringやLong型ではなく　Object型にします。そしてそのObjectの中に年齢と名前を入れます。

①オブジェクトに変数を入れる②連想配列のItemにそのオブジェクトを設定する③連想配列を読みだしたらそのObjectを元の変数型に戻す。

という手順をとるので、決して楽とも言えないです。

ソースコード（クラスモジュール）

モジュール名 Class1

Option Explicit

Public R1 As String ’1列目社員コードを入れます

Public R2 As Long ’2列目年齢を入れます

Public R3 As String　'3列目名前を入れます

標準モジュール

Sub Dict1TEST6()

Dim i As Long

Dim IT As Variant

Dim Dict1 As Object

Dim Item1 As Object

Set Dict1 = CreateObject("Scripting.Dictionary")

Dim Cls1 As Class1 'クラス変数としてCls1を宣言

For i = 2 To 6

If Dict1.Exists(Cells(i, 1).Value) = False Then 'もし連想配列にすでに登録されているキーがなければ

Set Cls1 = New Class1　’クラスのインスタンス化　上記のDim文とセットでこのプロシージャとクラスモジュールを連携

Cls1.R1 = Cells(i, 1).Value

Cls1.R2 = Cells(i, 2).Value

Cls1.R3 = Cells(i, 3).Value

Dict1.Add Cells(i, 1).Value, Cls1

End If

For Each IT In Dict1.Items

Set Cls1 = IT　　　'itemのオブジェクトを　クラスモジュールの各要素に代入

MsgBox Cls1.R1 & " " & Cls1.R2 & " " & Cls1.R3

Dim input1 As String

input1 = "A02"

If Not Dict1.Exists(input1) = False Then

Set Cls1 = Dict1(input1)　　　'itemのオブジェクトを　クラスモジュールの各要素に代入

MsgBox input1 & "　の年齢と名前 " & Cls1.R2 & " " & Cls1.R3

End If

End Sub

10-9　クラス変数の中に配列（みたいなもの）→ Collection　を設ける

クラス変数の中にはCollectionという配列のようなものを設定できます。その機能を使って、交通費をリストアップします。

ソースコード（クラスモジュール Class2)

Collectionの要素を取得するときの for文に注意願います（For Each TP In Cls2.tps1）

Option Explicit

Public R1 As String

Public R2 As Long

Public R3 As String

Public tps1 As Collection 'tps1がCollection であると宣言

Private Sub Class_Initialize()

Set tps1 = New Collection 'Collectionのインスタンス化

End Sub

ソースコード（標準モジュール）

Sub Dict1TEST7()

Dim i As Long, k As Long

Dim IT As Variant

Dim TP As Variant

Dim Dict1 As Object

Dim Item1 As Object

Dim Cls2 As Class2 'Cls2　が　クラスモジュールClass2を使うことを宣言

Set Dict1 = CreateObject("Scripting.Dictionary")

For i = 2 To 6

If Dict1.Exists(Cells(i, 1).Value) = False Then 'もし連想配列にすでに登録されているキーがなければ

Set Cls2 = New Class2

Cls2.R1 = Cells(i, 1).Value

Cls2.R2 = Cells(i, 2).Value

Cls2.R3 = Cells(i, 3).Value

For k = 4 To 8

If Cells(i, k) <> "" Then

Cls2.tps1.Add Cells(i, k).Value

Else

Exit For

End If

For Each IT In Dict1.Items

Set Cls2 = IT

For Each TP In Cls2.tps1

MsgBox Cls2.R1 & " " & Cls2.R2 & " " & Cls2.R3 & " " & TP

'特定のkeyに対するItemを表示する

Dim input1 As String

input1 = "A05"

If Not Dict1.Exists(input1) = False Then

Set Cls2 = Dict1(input1)

For Each TP In Cls2.tps1

MsgBox Cls2.R1 & " の年齢、名前、交通費 " & Cls2.R2 & " " & Cls2.R3 & " " & TP

End Sub