シートからグループ化してDictionaryを返す Excel VBA 関数

readToMap.vba

Function readToMap(ByVal fromSheetName As String)
    Dim result As Object
    Dim rowNum, i, groupName, entityName, ignore, dummyValue
    dummyValue = 0
    
    '' シート名 fromSheetName から読み取る
    '' 先頭1行はタイトル
    '' 1列目がグループ名、2列目がエンティティ名、3列目が空欄でない場合読み飛ばす
    '' 連続した行のみを対象として認識
    '' ネストした Scripting.Dictionary で結果を返す
    
    
    '' ここから実装
    ThisWorkbook.Sheets(fromSheetName).Activate
    rowNum = Range("A1").End(xlDown).Row
    
    Set result = CreateObject("Scripting.Dictionary")
    For i = 2 To rowNum
        groupName = Cells(i, 1).Value
        entityName = Cells(i, 2).Value
        ignore = Not IsEmpty(Cells(i, 3).Value)
        
        If ignore Then
            '' Continue
        ElseIf result.Exists(groupName) Then
            result.Item(groupName).Add entityName, dummyValue
        Else
            result.Add groupName, CreateObject("Scripting.Dictionary")
            result.Item(groupName).Add entityName, dummyValue
        End If
    Next i
    
    Set readToMap = result
End Function