ray88’s diary

お仕事で困ったとき用の自分用の覚書

VBA 部品 Dictionary作成

VBA Dictionaryの使い方 - ray88’s diary

Option Explicit
Sub ディクショナリ作成()
Dim masterFilePath As String
Dim objDictionary As Object
Dim wb As Workbook
Dim lastRow As Long
Dim masterTable As Variant
masterFilePath = "C:\デスクトップ\ExcelVBAプロジェクト\Dictionay\マスタ.xlsx"
'対象の表を読み込んでバリアント型配列に格納
Set wb = Workbooks.Open(masterFilePath)
With wb.Sheets("Sheet1")
    lastRow = .Cells(Rows.Count, 2).End(xlUp).Row
    masterTable = .Range(.Cells(3, 2), .Cells(lastRow, 3))
End With
wb.Close False
Set wb = Nothing
Set objDictionary = fncMakeDictionary(masterTable)
End Sub
Function fncMakeDictionary(testTable As Variant) As Object
'---------------------------------------------------------
'機 能:対象表を読み込んでディクショナリを生成する
'引 数:対象の表を格納したバリアント配列
'戻り値:対象の表をディクショナリ化して返す
'------------------------------------------------------------
    'Dictionaryオブジェクトの宣言
    Dim i As Long
    Dim myDic As Object
    Set myDic = CreateObject("Scripting.Dictionary")
    
    For i = 1 To UBound(testTable)
        myDic.Add testTable(i, 1), testTable(i, 2)
    Next
    '------------------------------------------------------------
    Dim str As String
    'バリアント型配列を宣言
    Dim Keys() As Variant
    'バリアント型配列にディクショナリのキーを格納
    Keys = myDic.Keys
    '------------------------------------------------------------
    'Dictionaryオブジェクトの要素の参照
    For i = 0 To UBound(testTable) - 1
        str = str & Keys(i) & " : " & myDic.Item(Keys(i)) & vbCrLf
    Next i
    
    MsgBox str, vbInformation

End Function