2019年10月4日 / 最終更新日時 : 2021年12月30日 officeの杜 msoffice

VBAで利用できる様々な配列処理

プログラミングをする上で欠かせないのが「配列処理」。Google Apps ScriptでもExcel VBAでも、この配列処理は必須の処理です。配列を使わずに例えば、Excelのマクロ的に１つずつセルを取得しては処理して移動みたいな動作は、プログラムの動作速度上非常に遅いだけでなく、プログラムが冗長になりメンテナンス性が損なわれます。

でかいシートデータを配列で取得して、様々な加工処理をメモリ上で行い、最後に一気に書き込み等をするといった作業が配列の主な役割ですが、VBAの場合およそ3種類ほどこの配列的な操作方法があります。今回はこの処理についてまとめてみました。

※配列の基礎的な内容ではなく、応用編になります。

1 今回使用するサンプルファイル
2 ソース
3 関連リンク

今回使用するサンプルファイル

※VBA-JSONは本項目の中では異色ですが、非常に有効な手段ですので身につけておいて損はありません。

※サンプルファイルのデータは、テストデータ・ジェネレータ様のサイトを利用させていただきました。

ソース

通常の配列操作

指定範囲を配列データとして取得する

Excelのシートに於いて、指定した範囲のデータを配列として取得する事が可能です。1セルずつ取得して検証を行うのではなく、まとめてデータ処理を行う事で、動作の高速化コードの短縮化に繋がり、プログラムの見通しが非常によくなります。以下に自分がよく使うコードについて記載をしてみます。

'シートの全データを配列で取得するコード
Public Function selectRange()
    '変数を宣言
    Dim dummyarr
    Dim lastrow As Long
    
    'dummyシートの全データの範囲指定
    With ThisWorkbook.Worksheets("dummy")
        'データのレコード数を取得する
        lastrow = .UsedRange.Rows.Count
        
        'データの範囲を指定して配列で取得する
        dummyarr = .Range("A2:L" & lastrow)

    End With
    
End Function

'シートの全データを配列で取得するコード

Public Function selectRange()

'変数を宣言

Dim dummyarr

Dim lastrow As Long

'dummyシートの全データの範囲指定

With ThisWorkbook.Worksheets("dummy")

'データのレコード数を取得する

lastrow = .UsedRange.Rows.Count

'データの範囲を指定して配列で取得する

dummyarr = .Range("A2:L" & lastrow)

End With

End Function

dummyarrが配列の入れ物になります
対象となるのはサンプルファイルのdummyという名のシートです。Worksheetsとして指定します。
全データを今回取得するのですが、データの最終行を知る必要があるので、UsedRange.Rows.Countにてデータとして有効な最終行の行番号を取得しています。
Range指定にて、範囲指定としてA2:Lの最終行を指定し、dummyarrに格納しています。
格納されたデータは二次元配列として格納されています。
withを使うとスッキリしたコードとして書けます。

動的に配列に値を追加する

JavaScriptなどは配列を用意してその配列にデータを追加したい時、pushしたりすればすんなり簡単に配列を追加する事が可能です。また、配列の中の順番を入れ替えてみたり、中身を操作してみたりもメソッドが用意されてるので非常に楽に配列操作が可能になっています。

しかし、VBAの場合言語自体が古い時代のもので、動的にホイホイそのままレコードの追加みたいな事ができません。ReDimというメソッドが用意されているのですが、今回のようなシートのデータの場合、配列の再定義ができるのは二次元目だけ（つまり列数）しか再定義が出来ません。

これでは行数を増やせないので困ります。そこでExcelのTranspose関数を組み合わせて、拡張後にも再度Transpose関数で行列入れ替えをして戻すというテクニックで指定の行数分だけ配列を拡張する事が可能です。また、この方法の場合、再定義後に配列のデータが消えるといった事もないので、動的に配列を拡張し、データの追加が可能です。

'二次元配列の行数を再定義する関数
Public Function chgReclength(ByVal dataArray, ByVal dlength)
    '一時的な配列を用意する
    Dim tempArray()
    
    'Transpose関数を使って配列に突っ込む
    tempArray = WorksheetFunction.Transpose(dataArray)
    
    'ReDimで配列の要素数を再定義
    ReDim Preserve tempArray(1 To UBound(tempArray, 1), 1 To dlength)
    
    '値を返す
    chgReclength = WorksheetFunction.Transpose(tempArray)
    
End Function

'二次元配列の行数を再定義する関数

Public Function chgReclength(ByVal dataArray, ByVal dlength)

'一時的な配列を用意する

Dim tempArray()

'Transpose関数を使って配列に突っ込む

tempArray = WorksheetFunction.Transpose(dataArray)

'ReDimで配列の要素数を再定義

ReDim Preserve tempArray(1 To UBound(tempArray, 1), 1 To dlength)

'値を返す

chgReclength = WorksheetFunction.Transpose(tempArray)

End Function

1回目のTranspose関数で配列データの縦横を入れ替えています。
ReDim Preserveにて要素数として指定のdlength分だけ行を拡張しています。
最後値を返す前に、再度Transpose関数にて行列を入れて元通りにして、返しています。

上記のchgReclength関数を利用して1行追加し、その行に値を追加する場合は以下のようなコードになります。

'シートの全データを配列で取得するコード
Public Function selectRange()
    '変数を宣言
    Dim dummyarr
    Dim lastrow As Long
    
    'dummyシートの全データの範囲指定
    With ThisWorkbook.Worksheets("dummy")
        'データのレコード数を取得する
        lastrow = .UsedRange.Rows.Count
        
        'データの範囲を指定して配列で取得する
        dummyarr = .Range("A2:L" & lastrow)

    End With
    
    '配列を拡張する(1行増やす）
    dummyarr = chgReclength(dummyarr, lastrow + 1)
    
    '配列最終行にデータ行を追加する
    dummyarr(lastrow + 1, 1) = lastrow + 1
    dummyarr(lastrow + 1, 2) = "北京原人"
    dummyarr(lastrow + 1, 3) = "ペキンハラヒト"
    dummyarr(lastrow + 1, 4) = "男"
    dummyarr(lastrow + 1, 5) = "AB"
    dummyarr(lastrow + 1, 6) = "1978/10/8"
    dummyarr(lastrow + 1, 7) = "03-1259-9644"
    dummyarr(lastrow + 1, 8) = "090-117-117"
    dummyarr(lastrow + 1, 9) = "pekin@gmail.com"
    dummyarr(lastrow + 1, 10) = "100-2528"
    dummyarr(lastrow + 1, 11) = "東京都小笠原村沖ノ鳥島"
    dummyarr(lastrow + 1, 12) = "トウキョウトオガサワラムラオキノトリシマ"

    ’追加されたデータがきちんと入ってるか確認してみる
    Debug.Print dummyarr(lastrow + 1, 7)
   
End Function

'シートの全データを配列で取得するコード

Public Function selectRange()

'変数を宣言

Dim dummyarr

Dim lastrow As Long

'dummyシートの全データの範囲指定

With ThisWorkbook.Worksheets("dummy")

'データのレコード数を取得する

lastrow = .UsedRange.Rows.Count

'データの範囲を指定して配列で取得する

dummyarr = .Range("A2:L" & lastrow)

End With

'配列を拡張する(1行増やす）

dummyarr = chgReclength(dummyarr, lastrow + 1)

'配列最終行にデータ行を追加する

dummyarr(lastrow + 1, 1) = lastrow + 1

dummyarr(lastrow + 1, 2) = "北京原人"

dummyarr(lastrow + 1, 3) = "ペキンハラヒト"

dummyarr(lastrow + 1, 4) = "男"

dummyarr(lastrow + 1, 5) = "AB"

dummyarr(lastrow + 1, 6) = "1978/10/8"

dummyarr(lastrow + 1, 7) = "03-1259-9644"

dummyarr(lastrow + 1, 8) = "090-117-117"

dummyarr(lastrow + 1, 9) = "pekin@gmail.com"

dummyarr(lastrow + 1, 10) = "100-2528"

dummyarr(lastrow + 1, 11) = "東京都小笠原村沖ノ鳥島"

dummyarr(lastrow + 1, 12) = "トウキョウトオガサワラムラオキノトリシマ"

’追加されたデータがきちんと入ってるか確認してみる

Debug.Print dummyarr(lastrow + 1, 7)

End Function

元のデータは4999件でしたが、chgReclength関数にて1件レコードを追加して5000件になっています。
その後最終行の要素に1つずつ値を格納し、debug.printで電話番号を参照してチェックしています（今回のケースで言えば、03-1259-9644が返ってくるはずです）

配列データのシート一括書き込み

VBAの場合配列データは、範囲指定をしてそこに配列を突っ込めばそのまま書き込みができる利便性があります。また、こうすることで1セルずつ書き込みといったような時間の掛かる処理をする必要がなくなり、短時間で処理が可能です。但し書き込みをする時に、要素数を足していた場合には、指定の範囲と配列の範囲がきちんと一致しているか？注意が必要です。

'シートの全データを配列で取得するコード
Public Function selectRange()
    '変数を宣言
    Dim dummyarr
    Dim lastrow As Long
    
    'dummyシートの全データの範囲指定
    With ThisWorkbook.Worksheets("dummy")
        'データのレコード数を取得する
        lastrow = .UsedRange.Rows.Count
        
        'データの範囲を指定して配列で取得する
        dummyarr = .Range("A2:L" & lastrow)

    End With
    
    '配列を拡張する(1行増やす）
    dummyarr = chgReclength(dummyarr, 5000)
    
    '配列最終行にデータ行を追加する
    dummyarr(5000, 1) = 5000
    dummyarr(5000, 2) = "北京原人"
    dummyarr(5000, 3) = "ペキンハラヒト"
    dummyarr(5000, 4) = "男"
    dummyarr(5000, 5) = "AB"
    dummyarr(5000, 6) = "1978/10/8"
    dummyarr(5000, 7) = "03-1259-9644"
    dummyarr(5000, 8) = "090-117-117"
    dummyarr(5000, 9) = "pekin@gmail.com"
    dummyarr(5000, 10) = "100-2528"
    dummyarr(5000, 11) = "東京都小笠原村沖ノ鳥島"
    dummyarr(5000, 12) = "トウキョウトオガサワラムラオキノトリシマ"
    
    '書き込み先の範囲指定
    With ThisWorkbook.Worksheets("edit")
        '指定のRangeに配列を突っ込む
        .Range("A2:L" & 5001) = dummyarr
    End With
End Function

'シートの全データを配列で取得するコード

Public Function selectRange()

'変数を宣言

Dim dummyarr

Dim lastrow As Long

'dummyシートの全データの範囲指定

With ThisWorkbook.Worksheets("dummy")

'データのレコード数を取得する

lastrow = .UsedRange.Rows.Count

'データの範囲を指定して配列で取得する

dummyarr = .Range("A2:L" & lastrow)

End With

'配列を拡張する(1行増やす）

dummyarr = chgReclength(dummyarr, 5000)

'配列最終行にデータ行を追加する

dummyarr(5000, 1) = 5000

dummyarr(5000, 2) = "北京原人"

dummyarr(5000, 3) = "ペキンハラヒト"

dummyarr(5000, 4) = "男"

dummyarr(5000, 5) = "AB"

dummyarr(5000, 6) = "1978/10/8"

dummyarr(5000, 7) = "03-1259-9644"

dummyarr(5000, 8) = "090-117-117"

dummyarr(5000, 9) = "pekin@gmail.com"

dummyarr(5000, 10) = "100-2528"

dummyarr(5000, 11) = "東京都小笠原村沖ノ鳥島"

dummyarr(5000, 12) = "トウキョウトオガサワラムラオキノトリシマ"

'書き込み先の範囲指定

With ThisWorkbook.Worksheets("edit")

'指定のRangeに配列を突っ込む

.Range("A2:L" & 5001) = dummyarr

End With

End Function

書き込み先の範囲指定も取得時と同様に範囲指定を行う。
Rangeの指定範囲に対して、配列を渡してあげています。但しこの時のレコード数はlastrowが5000なので1加えた5001としています（でないと追加した1行が欠損する）
無事に書き込みができれば、5000件目として追加したデータが5001行目に出てきます。

JSON形式の処理を利用した方法

素のVBAは古い言語であるため、JSONを扱う事が出来ません。しかし、VBA-JSONを使う事でJSONを扱うことが出来ます。JSON形式を用いた配列の処理は、一見すると面倒に見えますが単純な２次元配列として利用する場合、○列目といったような処理ではなく「列名」を用いて値の代入や参照ができるため、実務上非常に便利なシロモノです。

今回はVBA-JSON等を用いて、JSON形式の配列の作成およびその値の参照を行ってみたいと思います。事前に標準モジュールとしてJsonConverter.basを追加しておく必要があり、また参照設定としてMicrosoft Scripting Runtimeが必要です。

※最近はOfficeも64bitが標準になりつつあり、従来のScriptControlを使った手法は使えなくなりました。

JSON連想配列をデータの作成

VBA-JSONは文字列をJSONにする事はできますが、JSON文字列自体を作るようなメソッドはありません。VBAではJSONデータは普通にループを用いてゴリゴリ作成します。

'シートの全データをJSON形式で組み立てる関数
Public Function selectJson()
    '変数を宣言
    Dim dummyarr, titlecol
    Dim lastrow As Long
    Dim lastcol As Long
    
    'dummyシートの全データの範囲指定
    With ThisWorkbook.Worksheets("dummy")
        'データのレコード数を取得する
        lastrow = .UsedRange.Rows.Count
        lastcol = .UsedRange.Columns.Count
        
        'データの範囲を指定して配列で取得する
        dummyarr = .Range("A2:L" & lastrow)
        
        '列名を格納するする
        titlecol = .Range("A1:L1")
        
    End With
    
    'JSON形式の連想配列に値を格納してゆく
    Dim jsondata As String
    Dim counter As Integer
    Dim counter2 As Integer
    Dim tempstring As String
    Dim temptitle As String
    counter = 0
    jsondata = "["
    
    For i = 1 To lastrow - 1
        'counterが0以外の時カンマを追加する
        If counter = 0 Then
        Else
          jsondata = jsondata & ","
        End If
        
        'JSONデータを作成する
        jsondata = jsondata & "{"
        
        'カウンタ初期化
        counter2 = 0
    
        For j = 1 To lastcol
            'カウント初期化
        
            '文字列データをダブルコーテーションで括っておく
            tempstring = """" & dummyarr(i, j) & """"
            
            'タイトル文字列をダブルコーテーションでくくっておく
            temptitle = """" & titlecol(1, j) & """"
            
            'counter2が0以外の時カンマを追加する
            If counter2 = 0 Then
            Else
              jsondata = jsondata & ","
            End If
            
            'JSONレコードを追加
            jsondata = jsondata & temptitle & ":" & tempstring
            
            'カウントアップ
            counter2 = counter2 + 1
        
        Next j
        jsondata = jsondata & "}"
        
        'カウントアップ
        counter = counter + 1
    Next i
    jsondata = jsondata & "]"
    
    'JSONデータに変換する
    Dim Parse As Object
    Dim jsonrec As Variant
    Set Parse = JsonConverter.ParseJson(jsondata)

'シートの全データをJSON形式で組み立てる関数

Public Function selectJson()

'変数を宣言

Dim dummyarr, titlecol

Dim lastrow As Long

Dim lastcol As Long

'dummyシートの全データの範囲指定

With ThisWorkbook.Worksheets("dummy")

'データのレコード数を取得する

lastrow = .UsedRange.Rows.Count

lastcol = .UsedRange.Columns.Count

'データの範囲を指定して配列で取得する

dummyarr = .Range("A2:L" & lastrow)

'列名を格納するする

titlecol = .Range("A1:L1")

End With

'JSON形式の連想配列に値を格納してゆく

Dim jsondata As String

Dim counter As Integer

Dim counter2 As Integer

Dim tempstring As String

Dim temptitle As String

counter = 0

jsondata = "["

For i = 1 To lastrow - 1

'counterが0以外の時カンマを追加する

If counter = 0 Then

Else

jsondata = jsondata & ","

End If

'JSONデータを作成する

jsondata = jsondata & "{"

'カウンタ初期化

counter2 = 0

For j = 1 To lastcol

'カウント初期化

'文字列データをダブルコーテーションで括っておく

tempstring = """" & dummyarr(i, j) & """"

'タイトル文字列をダブルコーテーションでくくっておく

temptitle = """" & titlecol(1, j) & """"

'counter2が0以外の時カンマを追加する

If counter2 = 0 Then

Else

jsondata = jsondata & ","

End If

'JSONレコードを追加

jsondata = jsondata & temptitle & ":" & tempstring

'カウントアップ

counter2 = counter2 + 1

Next j

jsondata = jsondata & "}"

'カウントアップ

counter = counter + 1

Next i

jsondata = jsondata & "]"

'JSONデータに変換する

Dim Parse As Object

Dim jsonrec As Variant

Set Parse = JsonConverter.ParseJson(jsondata)

タイトル行のデータだけ別の配列として取得しておきます。
レコード分だけループで回しながら、さらにループでタイトル行の配列の値を持って、JSONを組み立てて値を格納してゆきます。
最後にVBA-JSONのJsonConverter.ParseJsonにてJSONとして取得させます。
5000行のデータを元に構築させたら結構な時間が掛かりました・・・・あまり大規模なデータ処理には向かないと思います。
一度JsonConverter.ParseJsonしてしまうと、そのオブジェクトに対して要素追加の手段がない（Scriptcontrolを使った場合、pushができるかもしれないけれど）

JSON連想配列データを参照

JsonConverter.ParseJsonしたオブジェクトから、JSONの値を取り出すためには、For eachで回して１行ずつ取り出す方法があります。通常の配列と違い一括で書き込み等はできない（もちろん、配列を用意してそこへJsonから取り出した値を格納したのち、配列を一発書き込みは可能）。

そこで１行ずつ取り出しては、１行ずつ書き込みをするコードを使います。

'シートの全データをJSON形式で組み立てる関数
Public Function selectJson()
    '変数を宣言
    Dim dummyarr, titlecol
    Dim lastrow As Long
    Dim lastcol As Long
    
    'dummyシートの全データの範囲指定
    With ThisWorkbook.Worksheets("dummy")
        'データのレコード数を取得する
        lastrow = .UsedRange.Rows.Count
        lastcol = .UsedRange.Columns.Count
        
        'データの範囲を指定して配列で取得する
        dummyarr = .Range("A2:L" & lastrow)
        
        '列名を格納するする
        titlecol = .Range("A1:L1")
        
    End With
    
    'JSON形式の連想配列に値を格納してゆく
    Dim jsondata As String
    Dim counter As Integer
    Dim counter2 As Integer
    Dim tempstring As String
    Dim temptitle As String
    counter = 0
    jsondata = "["
    
    For i = 1 To lastrow - 1
        'counterが0以外の時カンマを追加する
        If counter = 0 Then
        Else
          jsondata = jsondata & ","
        End If
        
        'JSONデータを作成する
        jsondata = jsondata & "{"
        
        'カウンタ初期化
        counter2 = 0
    
        For j = 1 To lastcol
            'カウント初期化
        
            '文字列データをダブルコーテーションで括っておく
            tempstring = """" & dummyarr(i, j) & """"
            
            'タイトル文字列をダブルコーテーションでくくっておく
            temptitle = """" & titlecol(1, j) & """"
            
            'counter2が0以外の時カンマを追加する
            If counter2 = 0 Then
            Else
              jsondata = jsondata & ","
            End If
            
            'JSONレコードを追加
            jsondata = jsondata & temptitle & ":" & tempstring
            
            'カウントアップ
            counter2 = counter2 + 1
        
        Next j
        jsondata = jsondata & "}"
        
        'カウントアップ
        counter = counter + 1
    
    
    Next i
    jsondata = jsondata & "]"
    
    'JSONデータに変換する
    Dim Parse As Object
    Dim jsonrec As Variant
    Dim cnt As Long
    Dim tempArray As Variant
    cnt = 2
    Set Parse = JsonConverter.ParseJson(jsondata)
    
    'JSONデータを参照し他のシートへ1行ずつ書き込む
    For Each jsonrec In Parse
        '1行文を配列として生成する
        tempArray = Array( _
                        jsonrec("ID"), _
                        jsonrec("名前"), _
                        jsonrec("名前フリガナ"), _
                        jsonrec("性別"), _
                        jsonrec("血液型"), _
                        jsonrec("生年月日"), _
                        jsonrec("電話番号"), _
                        jsonrec("携帯番号"), _
                        jsonrec("メール"), _
                        jsonrec("郵便番号"), _
                        jsonrec("住所"), _
                        jsonrec("住所フリガナ") _
        )
    
        '書き込み先の範囲指定
        With ThisWorkbook.Worksheets("edit")
            '指定のRangeに配列を突っ込む
            .Range("A" & cnt & ":L" & cnt) = tempArray
        End With

        'カウンターを回す
        cnt = cnt + 1
    
    Next

End Function

100

101

102

103

104

105

106

107

108

109

110

111

112

'シートの全データをJSON形式で組み立てる関数

Public Function selectJson()

'変数を宣言

Dim dummyarr, titlecol

Dim lastrow As Long

Dim lastcol As Long

'dummyシートの全データの範囲指定

With ThisWorkbook.Worksheets("dummy")

'データのレコード数を取得する

lastrow = .UsedRange.Rows.Count

lastcol = .UsedRange.Columns.Count

'データの範囲を指定して配列で取得する

dummyarr = .Range("A2:L" & lastrow)

'列名を格納するする

titlecol = .Range("A1:L1")

End With

'JSON形式の連想配列に値を格納してゆく

Dim jsondata As String

Dim counter As Integer

Dim counter2 As Integer

Dim tempstring As String

Dim temptitle As String

counter = 0

jsondata = "["

For i = 1 To lastrow - 1

'counterが0以外の時カンマを追加する

If counter = 0 Then

Else

jsondata = jsondata & ","

End If

'JSONデータを作成する

jsondata = jsondata & "{"

'カウンタ初期化

counter2 = 0

For j = 1 To lastcol

'カウント初期化

'文字列データをダブルコーテーションで括っておく

tempstring = """" & dummyarr(i, j) & """"

'タイトル文字列をダブルコーテーションでくくっておく

temptitle = """" & titlecol(1, j) & """"

'counter2が0以外の時カンマを追加する

If counter2 = 0 Then

Else

jsondata = jsondata & ","

End If

'JSONレコードを追加

jsondata = jsondata & temptitle & ":" & tempstring

'カウントアップ

counter2 = counter2 + 1

Next j

jsondata = jsondata & "}"

'カウントアップ

counter = counter + 1

Next i

jsondata = jsondata & "]"

'JSONデータに変換する

Dim Parse As Object

Dim jsonrec As Variant

Dim cnt As Long

Dim tempArray As Variant

cnt = 2

Set Parse = JsonConverter.ParseJson(jsondata)

'JSONデータを参照し他のシートへ1行ずつ書き込む

For Each jsonrec In Parse

'1行文を配列として生成する

tempArray = Array( _

jsonrec("ID"), _

jsonrec("名前"), _

jsonrec("名前フリガナ"), _

jsonrec("性別"), _

jsonrec("血液型"), _

jsonrec("生年月日"), _

jsonrec("電話番号"), _

jsonrec("携帯番号"), _

jsonrec("メール"), _

jsonrec("郵便番号"), _

jsonrec("住所"), _

jsonrec("住所フリガナ") _

)

'書き込み先の範囲指定

With ThisWorkbook.Worksheets("edit")

'指定のRangeに配列を突っ込む

.Range("A" & cnt & ":L" & cnt) = tempArray

End With

'カウンターを回す

cnt = cnt + 1

End Function

for eachにてjsonrecで１行取り出し、tempArrayにArray関数にて1行分の配列を作って、それを書き込みしています。
jsonrecで列名を指定すれば、列がランダムでもきちんと取り出せるため、元データ側にて「必要な列は用意されてる」「列名に変更はない」のであれば、その他の列が増えようが消えようが、コードはきちんと動作します（JSONを一番の理由はこれ）

ADOレコードセットを使った手法

Accessではおなじみの方法なのですが、Excel VBAではあまり使う機会が少ないかもしれない、けれど非常に便利で２次元配列を扱うのであるならば、レコードセットを使った配列処理がオススメです。配列のような簡便な機能ではなく非常に高機能で、ノウハウもたくさんあるので、メモリ上でデータ処理をしたいのであればレコードセットのほうがGoodです。

レコードセットの作成と追加

ExcelでADOを使う場合には、事前に参照設定を入れておきましょう（CreateObjectで入れなくても使えますが、入力補完が効かないので）。参照設定として追加する項目は「Microsoft ActiveX Data Objects 2.8 Library」です。

サンプルファイルにあるdummyという名前のシートデータを取得し、レコードを追加してみたいと思います。

'ADOを使ってシートデータをよしなにするコード
Public Function getsheetado()
    '変数を宣言
    Dim dummyarr
    Dim lastrow As Long
    Dim i As Long
    
    'dummyシートの全データの範囲指定
    With ThisWorkbook.Worksheets("dummy")
        'データのレコード数を取得する
        lastrow = .UsedRange.Rows.Count
        
        'データの範囲を指定して配列で取得する
        dummyarr = .Range("A2:L" & lastrow)

    End With

    'ADOの設定
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    
    'レコードセットの設定
    With rst
        'フィールドの設定
        With .Fields
            .Append "recID", adLongVarWChar, 255
            .Append "名前", adLongVarWChar, 255
            .Append "名前フリガナ", adLongVarWChar, 255
            .Append "性別", adLongVarWChar, 255
            .Append "血液型", adLongVarWChar, 255
            .Append "生年月日", adDate
            .Append "電話番号", adLongVarWChar, 255
            .Append "携帯番号", adLongVarWChar, 255
            .Append "メール", adLongVarWChar, 255
            .Append "郵便番号", adLongVarWChar, 255
            .Append "住所", adLongVarWChar, 255
            .Append "住所フリガナ", adLongVarWChar, 255
        End With
        
        'レコードセットを開く
        .Open
    End With

    '配列データからレコードセットへデータを追加
    For i = 1 To lastrow - 1
        With rst
            .AddNew
                !recID = dummyarr(i, 1)
                !名前 = dummyarr(i, 2)
                !名前フリガナ = dummyarr(i, 3)
                !性別 = dummyarr(i, 4)
                !血液型 = dummyarr(i, 5)
                !生年月日 = dummyarr(i, 6)
                !電話番号 = dummyarr(i, 7)
                !携帯番号 = dummyarr(i, 8)
                !メール = dummyarr(i, 9)
                !郵便番号 = dummyarr(i, 10)
                !住所 = dummyarr(i, 11)
                !住所フリガナ = dummyarr(i, 12)
            .Update
        End With
    Next i

    '新規にデータを1行追加する
    With rst
        .AddNew
                !recID = 5000
                !名前 = "北京原人"
                !名前フリガナ = "ペキンハラヒト"
                !性別 = "男"
                !血液型 = "AB"
                !生年月日 = "1978/10/8"
                !電話番号 = "03-1259-9644"
                !携帯番号 = "090-117-117"
                !メール = "pekin@gmail.com"
                !郵便番号 = "100-2528"
                !住所 = "東京都小笠原村沖ノ鳥島"
                !住所フリガナ = "トウキョウトオガサワラムラオキノトリシマ"
        .Update
    End With

End Function

'ADOを使ってシートデータをよしなにするコード

Public Function getsheetado()

'変数を宣言

Dim dummyarr

Dim lastrow As Long

Dim i As Long

'dummyシートの全データの範囲指定

With ThisWorkbook.Worksheets("dummy")

'データのレコード数を取得する

lastrow = .UsedRange.Rows.Count

'データの範囲を指定して配列で取得する

dummyarr = .Range("A2:L" & lastrow)

End With

'ADOの設定

Dim rst As ADODB.Recordset

Set rst = New ADODB.Recordset

'レコードセットの設定

With rst

'フィールドの設定

With .Fields

.Append "recID", adLongVarWChar, 255

.Append "名前", adLongVarWChar, 255

.Append "名前フリガナ", adLongVarWChar, 255

.Append "性別", adLongVarWChar, 255

.Append "血液型", adLongVarWChar, 255

.Append "生年月日", adDate

.Append "電話番号", adLongVarWChar, 255

.Append "携帯番号", adLongVarWChar, 255

.Append "メール", adLongVarWChar, 255

.Append "郵便番号", adLongVarWChar, 255

.Append "住所", adLongVarWChar, 255

.Append "住所フリガナ", adLongVarWChar, 255

End With

'レコードセットを開く

.Open

End With

'配列データからレコードセットへデータを追加

For i = 1 To lastrow - 1

With rst

.AddNew

!recID = dummyarr(i, 1)

!名前 = dummyarr(i, 2)

!名前フリガナ = dummyarr(i, 3)

!性別 = dummyarr(i, 4)

!血液型 = dummyarr(i, 5)

!生年月日 = dummyarr(i, 6)

!電話番号 = dummyarr(i, 7)

!携帯番号 = dummyarr(i, 8)

!メール = dummyarr(i, 9)

!郵便番号 = dummyarr(i, 10)

!住所 = dummyarr(i, 11)

!住所フリガナ = dummyarr(i, 12)

.Update

End With

Next i

'新規にデータを1行追加する

With rst

.AddNew

!recID = 5000

!名前 = "北京原人"

!名前フリガナ = "ペキンハラヒト"

!性別 = "男"

!血液型 = "AB"

!生年月日 = "1978/10/8"

!電話番号 = "03-1259-9644"

!携帯番号 = "090-117-117"

!メール = "pekin@gmail.com"

!郵便番号 = "100-2528"

!住所 = "東京都小笠原村沖ノ鳥島"

!住所フリガナ = "トウキョウトオガサワラムラオキノトリシマ"

.Update

End With

End Function

ADOを使う場合は必ずフィールドの型指定が必要です（配列だと全部Variant型でなんて大雑把な方法ですが）
フィールドにはNullでも良いよといったオプション指定を追加する事が可能です。
adVarChar型などの場合、必ずフィールドのサイズ(文字数）を指定する必要があります。ただしこのサイズには上限があるので注意。
データの追加は、.AddNewにて追加し、.Updateにて確定します。以上に簡単に的確な場所へ追加が可能です。
他にも.Filterにてデータのフィルタリングやソートが可能（例：rst.Filter = "血液型=AB" rst.Filter = "血液型 DESC")
レコードセットに対して、SQL文が利用可能です。
また、.Moveメソッドにてジャンプ、.bookmarkメソッドにてレコード位置を記憶などの豊富なメソッドが利用可能です。

図：参照設定を入れておくと楽です。

レコードセットのデータの参照

レコードセットの参照も非常に簡単です。今回は取得したレコードセットの中身のうち、電話番号だけを全部ピックアップするコードを書いてみました。

'ADOを使ってシートデータをよしなにするコード
Public Function getsheetado()
    '変数を宣言
    Dim dummyarr
    Dim lastrow As Long
    Dim i As Long
    
    'dummyシートの全データの範囲指定
    With ThisWorkbook.Worksheets("dummy")
        'データのレコード数を取得する
        lastrow = .UsedRange.Rows.Count
        
        'データの範囲を指定して配列で取得する
        dummyarr = .Range("A2:L" & lastrow)

    End With

    'ADOの設定
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    
    'レコードセットの設定
    With rst
        'フィールドの設定
        With .Fields
            .Append "recID", adLongVarWChar, 255
            .Append "名前", adLongVarWChar, 255
            .Append "名前フリガナ", adLongVarWChar, 255
            .Append "性別", adLongVarWChar, 255
            .Append "血液型", adLongVarWChar, 255
            .Append "生年月日", adDate
            .Append "電話番号", adLongVarWChar, 255
            .Append "携帯番号", adLongVarWChar, 255
            .Append "メール", adLongVarWChar, 255
            .Append "郵便番号", adLongVarWChar, 255
            .Append "住所", adLongVarWChar, 255
            .Append "住所フリガナ", adLongVarWChar, 255
        End With
        
        'レコードセットを開く
        .Open
    
    End With

    '配列データからレコードセットへデータを追加
    For i = 1 To lastrow - 1
        With rst
            .AddNew
                !recID = dummyarr(i, 1)
                !名前 = dummyarr(i, 2)
                !名前フリガナ = dummyarr(i, 3)
                !性別 = dummyarr(i, 4)
                !血液型 = dummyarr(i, 5)
                !生年月日 = dummyarr(i, 6)
                !電話番号 = dummyarr(i, 7)
                !携帯番号 = dummyarr(i, 8)
                !メール = dummyarr(i, 9)
                !郵便番号 = dummyarr(i, 10)
                !住所 = dummyarr(i, 11)
                !住所フリガナ = dummyarr(i, 12)
            .Update
        End With
    Next i
    
    '一旦レコードセットの先頭に移動する
    rst.MoveFirst
    
    'レコードセット内のデータの参照
    Do Until rst.EOF
    
        '電話番号をピックアップテスト
        Debug.Print rst("電話番号")
        
        '次のレコードへ移動
        rst.MoveNext
    
    Loop
End Function

'ADOを使ってシートデータをよしなにするコード

Public Function getsheetado()

'変数を宣言

Dim dummyarr

Dim lastrow As Long

Dim i As Long

'dummyシートの全データの範囲指定

With ThisWorkbook.Worksheets("dummy")

'データのレコード数を取得する

lastrow = .UsedRange.Rows.Count

'データの範囲を指定して配列で取得する

dummyarr = .Range("A2:L" & lastrow)

End With

'ADOの設定

Dim rst As ADODB.Recordset

Set rst = New ADODB.Recordset

'レコードセットの設定

With rst

'フィールドの設定

With .Fields

.Append "recID", adLongVarWChar, 255

.Append "名前", adLongVarWChar, 255

.Append "名前フリガナ", adLongVarWChar, 255

.Append "性別", adLongVarWChar, 255

.Append "血液型", adLongVarWChar, 255

.Append "生年月日", adDate

.Append "電話番号", adLongVarWChar, 255

.Append "携帯番号", adLongVarWChar, 255

.Append "メール", adLongVarWChar, 255

.Append "郵便番号", adLongVarWChar, 255

.Append "住所", adLongVarWChar, 255

.Append "住所フリガナ", adLongVarWChar, 255

End With

'レコードセットを開く

.Open

End With

'配列データからレコードセットへデータを追加

For i = 1 To lastrow - 1

With rst

.AddNew

!recID = dummyarr(i, 1)

!名前 = dummyarr(i, 2)

!名前フリガナ = dummyarr(i, 3)

!性別 = dummyarr(i, 4)

!血液型 = dummyarr(i, 5)

!生年月日 = dummyarr(i, 6)

!電話番号 = dummyarr(i, 7)

!携帯番号 = dummyarr(i, 8)

!メール = dummyarr(i, 9)

!郵便番号 = dummyarr(i, 10)

!住所 = dummyarr(i, 11)

!住所フリガナ = dummyarr(i, 12)

.Update

End With

Next i

'一旦レコードセットの先頭に移動する

rst.MoveFirst

'レコードセット内のデータの参照

Do Until rst.EOF

'電話番号をピックアップテスト

Debug.Print rst("電話番号")

'次のレコードへ移動

rst.MoveNext

Loop

End Function

レコードセット追加直後は、レコードセットの末端にいる状態なので、まずは.MoveFirstでレコードの先頭まで移動します。
Do Until rst.EOFループにてレコードセットの終端までループさせます。
rst(フィールド名)にて、値を取り出す事が可能です。また、rst!フィールド名でも可能ですが、予約語などとバッティングした場合エラーになるので注意。
必ず.MoveNextで次のレコードへ移動しないと、無限ループになるので注意

シートへ一発書き込みをする

配列の利点は、配列データを指定の範囲内に一括で書き出しができる点でした。他の配列系の処理は一括書き出しをするメソッドがないので不便ですね。レコードセットにはCopyFromRecordsetという便利なメソッドがあり、あっさり一発で出力が可能です。AccessからExcelをオートメーション処理で出力する際にもよく利用します。

'ADOを使ってシートデータをよしなにするコード
Public Function getsheetado()
    '変数を宣言
    Dim dummyarr
    Dim lastrow As Long
    Dim i As Long
    
    'dummyシートの全データの範囲指定
    With ThisWorkbook.Worksheets("dummy")
        'データのレコード数を取得する
        lastrow = .UsedRange.Rows.Count
        
        'データの範囲を指定して配列で取得する
        dummyarr = .Range("A2:L" & lastrow)

    End With

    'ADOの設定
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    
    'レコードセットの設定
    With rst
        'フィールドの設定
        With .Fields
            .Append "recID", adLongVarWChar, 255
            .Append "名前", adLongVarWChar, 255
            .Append "名前フリガナ", adLongVarWChar, 255
            .Append "性別", adLongVarWChar, 255
            .Append "血液型", adLongVarWChar, 255
            .Append "生年月日", adDate
            .Append "電話番号", adLongVarWChar, 255
            .Append "携帯番号", adLongVarWChar, 255
            .Append "メール", adLongVarWChar, 255
            .Append "郵便番号", adLongVarWChar, 255
            .Append "住所", adLongVarWChar, 255
            .Append "住所フリガナ", adLongVarWChar, 255
        End With
        
        'レコードセットを開く
        .Open
    
    End With

    '配列データからレコードセットへデータを追加
    For i = 1 To lastrow - 1
        With rst
            .AddNew
                !recID = dummyarr(i, 1)
                !名前 = dummyarr(i, 2)
                !名前フリガナ = dummyarr(i, 3)
                !性別 = dummyarr(i, 4)
                !血液型 = dummyarr(i, 5)
                !生年月日 = dummyarr(i, 6)
                !電話番号 = dummyarr(i, 7)
                !携帯番号 = dummyarr(i, 8)
                !メール = dummyarr(i, 9)
                !郵便番号 = dummyarr(i, 10)
                !住所 = dummyarr(i, 11)
                !住所フリガナ = dummyarr(i, 12)
            .Update
        End With
    Next i
    
    '新規にデータを1行追加する
    With rst
        .AddNew
                !recID = 5000
                !名前 = "北京原人"
                !名前フリガナ = "ペキンハラヒト"
                !性別 = "男"
                !血液型 = "AB"
                !生年月日 = "1978/10/8"
                !電話番号 = "03-1259-9644"
                !携帯番号 = "090-117-117"
                !メール = "pekin@gmail.com"
                !郵便番号 = "100-2528"
                !住所 = "東京都小笠原村沖ノ鳥島"
                !住所フリガナ = "トウキョウトオガサワラムラオキノトリシマ"
        .Update
    End With
    
    '書き出すためにレコードセットの先頭に移動する
    rst.MoveFirst

    'editシートへレコードセットの中身を一括書き出し
    With ThisWorkbook.Worksheets("edit")
        'A2の位置からeditシートへ書き出し
        .Range("A2").CopyFromRecordset rst
    End With

    '終了処理
    rst.Close
    Set rst = Nothing
End Function

'ADOを使ってシートデータをよしなにするコード

Public Function getsheetado()

'変数を宣言

Dim dummyarr

Dim lastrow As Long

Dim i As Long

'dummyシートの全データの範囲指定

With ThisWorkbook.Worksheets("dummy")

'データのレコード数を取得する

lastrow = .UsedRange.Rows.Count

'データの範囲を指定して配列で取得する

dummyarr = .Range("A2:L" & lastrow)

End With

'ADOの設定

Dim rst As ADODB.Recordset

Set rst = New ADODB.Recordset

'レコードセットの設定

With rst

'フィールドの設定

With .Fields

.Append "recID", adLongVarWChar, 255

.Append "名前", adLongVarWChar, 255

.Append "名前フリガナ", adLongVarWChar, 255

.Append "性別", adLongVarWChar, 255

.Append "血液型", adLongVarWChar, 255

.Append "生年月日", adDate

.Append "電話番号", adLongVarWChar, 255

.Append "携帯番号", adLongVarWChar, 255

.Append "メール", adLongVarWChar, 255

.Append "郵便番号", adLongVarWChar, 255

.Append "住所", adLongVarWChar, 255

.Append "住所フリガナ", adLongVarWChar, 255

End With

'レコードセットを開く

.Open

End With

'配列データからレコードセットへデータを追加

For i = 1 To lastrow - 1

With rst

.AddNew

!recID = dummyarr(i, 1)

!名前 = dummyarr(i, 2)

!名前フリガナ = dummyarr(i, 3)

!性別 = dummyarr(i, 4)

!血液型 = dummyarr(i, 5)

!生年月日 = dummyarr(i, 6)

!電話番号 = dummyarr(i, 7)

!携帯番号 = dummyarr(i, 8)

!メール = dummyarr(i, 9)

!郵便番号 = dummyarr(i, 10)

!住所 = dummyarr(i, 11)

!住所フリガナ = dummyarr(i, 12)

.Update

End With

Next i

'新規にデータを1行追加する

With rst

.AddNew

!recID = 5000

!名前 = "北京原人"

!名前フリガナ = "ペキンハラヒト"

!性別 = "男"

!血液型 = "AB"

!生年月日 = "1978/10/8"

!電話番号 = "03-1259-9644"

!携帯番号 = "090-117-117"

!メール = "pekin@gmail.com"

!郵便番号 = "100-2528"

!住所 = "東京都小笠原村沖ノ鳥島"

!住所フリガナ = "トウキョウトオガサワラムラオキノトリシマ"

.Update

End With

'書き出すためにレコードセットの先頭に移動する

rst.MoveFirst

'editシートへレコードセットの中身を一括書き出し

With ThisWorkbook.Worksheets("edit")

'A2の位置からeditシートへ書き出し

.Range("A2").CopyFromRecordset rst

End With

'終了処理

rst.Close

Set rst = Nothing

End Function

配列と違い、レコードのレコード数と列数を意識する事なくメソッド一発で、指定の位置からデータを吐き出せます。
レコード追加直後はレコードセット末端にいるので、必ず.MoveFirstで先頭に移動してから出力しましょう。でないと最後の1行だけが出力されてしまいます。
一発書き出しなので非常に高速にシート上へデータの展開が可能です。
ADOでのレコード処理は非常に高速なので、速度面でもADOの利用は推奨です。

Dictionaryを利用した二次元配列

配列はデータの追加などが非常に面倒でどうにかしたい！という方が、ウェブを探して次に行き当たる方法が「Dictionaryを二重に利用した二次元配列構造」です。単一のDictionaryですと1次元でしかないので、KeyとItemの対の構造が出来ておしまいであるため、表のような二次元配列としては利用できません。

今回利用するDictionaryは、事前に参照設定を入れておきましょう（CreateObjectで入れなくても使えますが、入力補完が効かないので）。参照設定として追加する項目は「Microsoft Scripting Runtime」です。

図：Scripting Runtimeは非常によく利用します

Dictionaryデータの作成

親となるDictionaryとは別にループ内で子となるDictionaryを作成し、その中に配列のデータを流し込んでいます。Dictionaryはaddメソッドにて簡単にレコードデータを追加できますが、必ずキーと値というペアで設定が必要になります。そこで今回は、キーにタイトル行の値を利用し、値は各レコードの値を入れるようにしました（arrListというオブジェクト内にキーが入っていますので、arrList(1)でIDというキーが取り出せます）

'多次元Dictionaryを利用した配列処理を行うコード
Public Function getDicArray()
    '変数を宣言
    Dim dummyarr, arrList
    Dim lastrow As Long
    Dim i As Long
    Dim buf As String
    
    'dummyシートの全データの範囲指定
    With ThisWorkbook.Worksheets("dummy")
        'データのレコード数を取得する
        lastrow = .UsedRange.Rows.Count
        
        'データの範囲を指定して配列で取得する
        dummyarr = .Range("A1:L" & lastrow)

    End With

    'Dictionaryの準備（一次元目）
    Dim oDic As Dictionary
    Dim oDic_Child As Dictionary
    Set oDic = New Dictionary

    '配列データをDictionaryへ格納してゆく
    For i = LBound(dummyarr, 1) + 1 To UBound(dummyarr, 1)
        'Dictionaryの準備（二次元目）
        Set oDic_Child = New Dictionary
        
        'Dictionaryにデータを追加
        With oDic_Child
            .Add dummyarr(1, 1), dummyarr(i, 1)
            .Add dummyarr(1, 2), dummyarr(i, 2)
            .Add dummyarr(1, 3), dummyarr(i, 3)
            .Add dummyarr(1, 4), dummyarr(i, 4)
            .Add dummyarr(1, 5), dummyarr(i, 5)
            .Add dummyarr(1, 6), dummyarr(i, 6)
            .Add dummyarr(1, 7), dummyarr(i, 7)
            .Add dummyarr(1, 8), dummyarr(i, 8)
            .Add dummyarr(1, 9), dummyarr(i, 9)
            .Add dummyarr(1, 10), dummyarr(i, 10)
            .Add dummyarr(1, 11), dummyarr(i, 11)
            .Add dummyarr(1, 12), dummyarr(i, 12)
        End With

        '一次元目のDictionaryに追加
        oDic.Add dummyarr(i, 1), oDic_Child
        
        '閉じる
        Set oDic_Child = Nothing
    Next i
    
    'Dictionaryのデータを出力
    For i = 0 To oDic.Count - 1
        'Keyを取得する
        buf = vbNullString
        arrList = oDic(oDic.Keys(i)).Keys
        
        'ループでDictionaryのデータを書き出し
        For j = LBound(arrList) To UBound(arrList)
            buf = buf & oDic(oDic.Keys(i))(arrList(j)) & ","
        Next
        
        'バッファに取り出したデータを書き出し
        buf = Mid(buf, 1, Len(buf) - 1)
        Debug.Print buf
    Next

    '終了処理
    Set oDic = Nothing
End Function

'多次元Dictionaryを利用した配列処理を行うコード

Public Function getDicArray()

'変数を宣言

Dim dummyarr, arrList

Dim lastrow As Long

Dim i As Long

Dim buf As String

'dummyシートの全データの範囲指定

With ThisWorkbook.Worksheets("dummy")

'データのレコード数を取得する

lastrow = .UsedRange.Rows.Count

'データの範囲を指定して配列で取得する

dummyarr = .Range("A1:L" & lastrow)

End With

'Dictionaryの準備（一次元目）

Dim oDic As Dictionary

Dim oDic_Child As Dictionary

Set oDic = New Dictionary

'配列データをDictionaryへ格納してゆく

For i = LBound(dummyarr, 1) + 1 To UBound(dummyarr, 1)

'Dictionaryの準備（二次元目）

Set oDic_Child = New Dictionary

'Dictionaryにデータを追加

With oDic_Child

.Add dummyarr(1, 1), dummyarr(i, 1)

.Add dummyarr(1, 2), dummyarr(i, 2)

.Add dummyarr(1, 3), dummyarr(i, 3)

.Add dummyarr(1, 4), dummyarr(i, 4)

.Add dummyarr(1, 5), dummyarr(i, 5)

.Add dummyarr(1, 6), dummyarr(i, 6)

.Add dummyarr(1, 7), dummyarr(i, 7)

.Add dummyarr(1, 8), dummyarr(i, 8)

.Add dummyarr(1, 9), dummyarr(i, 9)

.Add dummyarr(1, 10), dummyarr(i, 10)

.Add dummyarr(1, 11), dummyarr(i, 11)

.Add dummyarr(1, 12), dummyarr(i, 12)

End With

'一次元目のDictionaryに追加

oDic.Add dummyarr(i, 1), oDic_Child

'閉じる

Set oDic_Child = Nothing

Next i

'Dictionaryのデータを出力

For i = 0 To oDic.Count - 1

'Keyを取得する

buf = vbNullString

arrList = oDic(oDic.Keys(i)).Keys

'ループでDictionaryのデータを書き出し

For j = LBound(arrList) To UBound(arrList)

buf = buf & oDic(oDic.Keys(i))(arrList(j)) & ","

'バッファに取り出したデータを書き出し

buf = Mid(buf, 1, Len(buf) - 1)

Debug.Print buf

'終了処理

Set oDic = Nothing

End Function

oDic.Keys(i)にて、レコード番号が取り出せます
bufには、カンマ区切りでDictionaryのデータが構築されて出力されて来ます。
.addメソッドの1つ目の引数である「キー」にはタイトル行の名前を入れ、2つ目の引数である値に各レコードの値を格納しています。
作り方はJavaScriptの多重連想配列の作り方に似ていて、一時配列を親の配列に都度pushするような感じです。
Debug.Print oDic(oDic.Keys(2))(arrList(2))とすると、3行目の3列目であるオカザキコウキという値が手に入ります。

Dictionaryの書き出し

Dictionaryは配列ではないので、一気に書き出しするような事はできませんが、前回のコードの最後ではカンマ区切りで1行のレコードが返ってきました。そこでこれをSplit関数で一次元配列にし、1行単位で書き込むようにしてみました。

'多次元Dictionaryを利用した配列処理を行うコード
Public Function getDicArray()
    '変数を宣言
    Dim dummyarr, arrList
    Dim lastrow As Long
    Dim i As Long
    Dim buf As String
    Dim cnt As Integer
    cnt = 2
    
    'dummyシートの全データの範囲指定
    With ThisWorkbook.Worksheets("dummy")
        'データのレコード数を取得する
        lastrow = .UsedRange.Rows.Count
        
        'データの範囲を指定して配列で取得する
        dummyarr = .Range("A1:L" & lastrow)

    End With

    'Dictionaryの準備（一次元目）
    Dim oDic As Dictionary
    Dim oDic_Child As Dictionary
    Set oDic = New Dictionary

    '配列データをDictionaryへ格納してゆく
    For i = LBound(dummyarr, 1) + 1 To UBound(dummyarr, 1)
        'Dictionaryの準備（二次元目）
        Set oDic_Child = New Dictionary
        
        'Dictionaryにデータを追加
        With oDic_Child
            .Add dummyarr(1, 1), dummyarr(i, 1)
            .Add dummyarr(1, 2), dummyarr(i, 2)
            .Add dummyarr(1, 3), dummyarr(i, 3)
            .Add dummyarr(1, 4), dummyarr(i, 4)
            .Add dummyarr(1, 5), dummyarr(i, 5)
            .Add dummyarr(1, 6), dummyarr(i, 6)
            .Add dummyarr(1, 7), dummyarr(i, 7)
            .Add dummyarr(1, 8), dummyarr(i, 8)
            .Add dummyarr(1, 9), dummyarr(i, 9)
            .Add dummyarr(1, 10), dummyarr(i, 10)
            .Add dummyarr(1, 11), dummyarr(i, 11)
            .Add dummyarr(1, 12), dummyarr(i, 12)
        End With

        '一次元目のDictionaryに追加
        oDic.Add dummyarr(i, 1), oDic_Child
        
        '閉じる
        Set oDic_Child = Nothing

    Next i
    
    'Dictionaryのデータを出力
    For i = 0 To oDic.Count - 1

        'Keyを取得する
        buf = vbNullString    'bufをNullにする
        arrList = oDic(oDic.Keys(i)).Keys  'タイトル行の名前
        'Debug.Print oDic.Keys(i)
        
        'ループでDictionaryのデータを書き出し
        For j = LBound(arrList) To UBound(arrList)
            '各キーに対応する値をカンマ区切りで生成
            buf = buf & oDic(oDic.Keys(i))(arrList(j)) & ","
        Next
        
        'バッファに取り出したデータを書き出し
        buf = Mid(buf, 1, Len(buf) - 1)

        'tempArrayをシートに書き込む
        With ThisWorkbook.Worksheets("edit")
            .Range("A" & cnt & ":L" & cnt) = Split(buf, ",")
        End With
        
        'カウンタを回す
        cnt = cnt + 1
    Next

    '終了処理
    Set oDic = Nothing

End Function

'多次元Dictionaryを利用した配列処理を行うコード

Public Function getDicArray()

'変数を宣言

Dim dummyarr, arrList

Dim lastrow As Long

Dim i As Long

Dim buf As String

Dim cnt As Integer

cnt = 2

'dummyシートの全データの範囲指定

With ThisWorkbook.Worksheets("dummy")

'データのレコード数を取得する

lastrow = .UsedRange.Rows.Count

'データの範囲を指定して配列で取得する

dummyarr = .Range("A1:L" & lastrow)

End With

'Dictionaryの準備（一次元目）

Dim oDic As Dictionary

Dim oDic_Child As Dictionary

Set oDic = New Dictionary

'配列データをDictionaryへ格納してゆく

For i = LBound(dummyarr, 1) + 1 To UBound(dummyarr, 1)

'Dictionaryの準備（二次元目）

Set oDic_Child = New Dictionary

'Dictionaryにデータを追加

With oDic_Child

.Add dummyarr(1, 1), dummyarr(i, 1)

.Add dummyarr(1, 2), dummyarr(i, 2)

.Add dummyarr(1, 3), dummyarr(i, 3)

.Add dummyarr(1, 4), dummyarr(i, 4)

.Add dummyarr(1, 5), dummyarr(i, 5)

.Add dummyarr(1, 6), dummyarr(i, 6)

.Add dummyarr(1, 7), dummyarr(i, 7)

.Add dummyarr(1, 8), dummyarr(i, 8)

.Add dummyarr(1, 9), dummyarr(i, 9)

.Add dummyarr(1, 10), dummyarr(i, 10)

.Add dummyarr(1, 11), dummyarr(i, 11)

.Add dummyarr(1, 12), dummyarr(i, 12)

End With

'一次元目のDictionaryに追加

oDic.Add dummyarr(i, 1), oDic_Child

'閉じる

Set oDic_Child = Nothing

Next i

'Dictionaryのデータを出力

For i = 0 To oDic.Count - 1

'Keyを取得する

buf = vbNullString 'bufをNullにする

arrList = oDic(oDic.Keys(i)).Keys 'タイトル行の名前

'Debug.Print oDic.Keys(i)

'ループでDictionaryのデータを書き出し

For j = LBound(arrList) To UBound(arrList)

'各キーに対応する値をカンマ区切りで生成

buf = buf & oDic(oDic.Keys(i))(arrList(j)) & ","

'バッファに取り出したデータを書き出し

buf = Mid(buf, 1, Len(buf) - 1)

'tempArrayをシートに書き込む

With ThisWorkbook.Worksheets("edit")

.Range("A" & cnt & ":L" & cnt) = Split(buf, ",")

End With

'カウンタを回す

cnt = cnt + 1

'終了処理

Set oDic = Nothing

End Function

bufの値はカンマ区切りなので、Split関数にて一次元配列にした状態のものを書き込むワークシートの範囲を指定して代入するだけで書き込みがなされます。
Dictionaryの操作は決して早いものではないので、大規模に使うのであればレコードセットの使用をおすすめします（階層が深くなるとわけわからなくなりますし）。

VBAで利用できる様々な配列処理

今回使用するサンプルファイル

ソース

通常の配列操作

指定範囲を配列データとして取得する

動的に配列に値を追加する

配列データのシート一括書き込み

JSON形式の処理を利用した方法

JSON連想配列をデータの作成

JSON連想配列データを参照

ADOレコードセットを使った手法

レコードセットの作成と追加

レコードセットのデータの参照

シートへ一発書き込みをする

Dictionaryを利用した二次元配列

Dictionaryデータの作成

Dictionaryの書き出し

関連リンク

コメントを残すコメントをキャンセル

Google Apps Scriptで組織図を作ろう【GAS】

Electronで画像をサーバに送信して保存する

今回使用するサンプルファイル

ソース

通常の配列操作

指定範囲を配列データとして取得する

動的に配列に値を追加する

配列データのシート一括書き込み

JSON形式の処理を利用した方法

JSON連想配列をデータの作成

JSON連想配列データを参照

ADOレコードセットを使った手法

レコードセットの作成と追加

レコードセットのデータの参照

シートへ一発書き込みをする

Dictionaryを利用した二次元配列

Dictionaryデータの作成

Dictionaryの書き出し

関連リンク

コメントを残す コメントをキャンセル

Google Apps Scriptで組織図を作ろう【GAS】

Electronで画像をサーバに送信して保存する

コメントを残すコメントをキャンセル