LoginSignup
1
1

More than 3 years have passed since last update.

セルを指定してCurrentRegionで範囲取得した表を、キー+配列でDictionaryにブチ込む

Last updated at Posted at 2019-10-17

セルを指定して、そこの表を CurrentRegion.value で配列にブチ込めます。
これを応用して、範囲取得した表が何行であっても
一番左の列:キー
その他の列:配列
としてDictionaryに格納できるようにしました。
これで、表のデータを取るのがだいぶ便利になります。

下の例で書き方を説明すると、
dic(菊池)(1)と書いたら 168、dic(芦田)(2) と書いたら44が呼び出せます。

実質的な本体はたった7行ですが、ものすごく頭を使いました。自分の汗と試行錯誤の結晶です。


[テストデータ]
testdata.png

testDic.bas
    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
    Dim arr As Variant: arr = Sheets("Sheet2").Range("E6").CurrentRegion.Value
    Dim arrItem()
    Dim maxColNum_0 As Integer: maxColNum_0 = UBound(arr, 2) - 2
    Dim LP1 As Long, LP2 As Long

    ReDim arrItem(maxColNum_0)

    For LP1 = 2 To UBound(arr, 1)
        For LP2 = 0 To maxColNum_0
            arrItem(LP2) = arr(LP1, LP2 + 2)
        Next LP2
        dic.Add arr(LP1, 1), arrItem
    Next LP1


'----デバッグ部----
'配列の中身を全部見せ
  Dim i As Integer, j As Integer, str As String
  Dim maxRow As Integer:  maxRow = UBound(arr, 1)
  Dim maxColumn As Integer: maxColumn = UBound(arr, 2)

  For i = 1 To maxRow
    For j = 1 To maxColumn
        str = "arr(" & i & ", " & j & ")=" & arr(i, j)
        Debug.Print str
    Next
    Debug.Print
  Next

'Dicの中身を全部見せ
    Dim var As Variant
    For Each var In dic
        Debug.Print "キー:" & var
        For LP2 = 0 To maxColNum_0
            Debug.Print "dic(" & var & ")(" & LP2 & "):", dic(var)(LP2)
        Next LP2
    Next var
End Sub

[実行結果]
imidiate1.png
imidiate2.png

1
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
1