エクセル　VBA　シートの値を２次元配列に（取り出し方）(追記あり)

エクセル　VBA　シートの値を２次元配列に（取り出し方）

初心者の備忘録

下記のようにエクセルシート１５列のデータを２次元配列に入れるとする。

data_hairetu = Range(Cells(1, 1), Cells(LastRow1, 15))

配列全体の取り出しは下記でできる

Range(Cells(1, 1), Cells(UBound(data_hairetu), 15)) = data_hairetu

では、１行ずつ取り出すにはどうするか？
１列ずつfor文でdata_hairetu(1,a)とかで取り出すのかなと思ったら、
index関数が使えるとのこと。
Range(Cells(1, 1), Cells(1, 15)) = WorksheetFunction.Index(data_hairetu, aa)
なるほど。

追記indexでの取り出しだが、元の全データが１行の場合はうまくいかなかった。取り出した列のデータのうち、一列目のみを全部の列に書き込んでいた。

（一応、２次元配列にはなっているようだけど。）結局、for文で回すのを採用した。

以下、検証例

Sub hairetu_index_tamesi2X2_全部貼り付け() '２行全部貼り付けの場合・・・問題ない

Dim data_hairetu As Variant
Worksheets("Sheet1").Activate
data_hairetu = Worksheets("Sheet1").Range(Cells(1, 1), Cells(2, 2))
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Range(Cells(1, 1), Cells(UBound(data_hairetu), 2)) = data_hairetu

End Sub

Sub hairetu_index_tamesi1X2_全部貼り付け() '１行全部貼り付けの場合・・・問題ない

Dim data_hairetu As Variant
Worksheets("Sheet1").Activate
data_hairetu = Worksheets("Sheet1").Range(Cells(1, 1), Cells(1, 2))
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Range(Cells(1, 1), Cells(UBound(data_hairetu), 2)) = data_hairetu

End Sub

Sub hairetu_index_tamesi2X2_1行のみ貼り付け() '１行全部貼り付けの場合・・・問題ない

End Sub

Sub hairetu_index_tamesi1X2_1行のみ貼り付け() '１行全部貼り付けの場合・・・これだと１セルの内容を１列と２列に書く
'（元が１行だと多次元にならない？）

' Dim data_hairetu() As Variant '()かっこを付ける()型が一致しない
Dim data_hairetu As Variant
Worksheets("Sheet1").Activate
data_hairetu = Worksheets("Sheet1").Range(Cells(1, 1), Cells(1, 2))
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Range(Cells(1, 1), Cells(1, 2)) = WorksheetFunction.Index(data_hairetu, 1)

End Sub

Sub hairetu_index_tamesi1X2_1行のみ貼り付け回避() '１行全部貼り付けの場合・・・これだと１セルの内容を１列と２列に書く
'（元が１行だと多次元にならない？）
'
'' Dim data_hairetu() As Variant '()かっこを付ける()型が一致しない
' Dim data_hairetu As Variant
Worksheets("Sheet1").Activate

'1行の場合は直貼り
Dim data_hani As Range

Set data_hani = Worksheets("Sheet1").Range(Cells(1, 1), Cells(1, 2))

' data_hairetu = Worksheets("Sheet1").Range(Cells(1, 1), Cells(1, 2))
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Range(Cells(1, 1), Cells(1, 2)) = data_hani.Value

End Sub

Sub 次元数確認1X2() '答えは２次元

Dim TempData As Variant
Dim i As Long

Dim data_hairetu As Variant
Worksheets("Sheet1").Activate
data_hairetu = Worksheets("Sheet1").Range(Cells(1, 1), Cells(1, 2))

On Error Resume Next
Do While Err.Number = 0
i = i + 1
TempData = UBound(data_hairetu, i)
Loop
On Error GoTo 0

MsgBox "次元数は " & i - 1 & " です。"
End Sub

最終（実際の例でR1は最終行。１列目で合致項目を探し、１５列まで転記する場合）

For aa = LBound(data_hairetu) To UBound(data_hairetu)
For bb = 1 To R1
If data_hairetu(aa, 1) = Sheet1.Cells(bb, 1).Value Then

Dim aaa As Long

For aaa = 1 To 15

Cells(bb, aaa) = data_hairetu(aa, aaa)

Next aaa
Exit For

End If
Next bb