エクセルVBAで配列の追加

質問

エクセル2000です。
1行4列のセル範囲のデータを配列に取り込んで、後から別の1行4列のセル範囲のデータを配列に追加し、2次元配列として吐き出そうと思います。
最初の範囲がA1:D1、追加範囲がA4:D4とした場合、こんな不細工なコードになってしまいました。
これでも動きますが、どう修正すべきでしょうか？

Sub test()
Dim myAr()
myAr = Application.Transpose(Range("A1:D1").Value)
ReDim Preserve myAr(1 To 4, 1 To 2)
For i = 1 To 4
myAr(i, 2) = Cells(4, i)
Next i
Range("F1").Resize(UBound(myAr, 2), UBound(myAr, 1)).Value = Application.Transpose(myAr)
End Sub

回答No.4

end-u · ベストアンサー

申し訳ない...orz
FormulaArrayを使えば良かったです。失念しておりました。

Sub pre()
　　Dim v

　　v = Array("A", "B", "C", "D")
　　Call test4(v)
End Sub

Sub test4(v)
　　Dim x　 As Long
　　Dim n　 As Long
　　Dim i　 As Long
　　Dim cnt As Long
　　Dim z

　　x = UBound(v) - LBound(v) + 1
　　With Range("A1").CurrentRegion.Resize(, x)
　　　　n = .Rows.Count
　　　　ReDim w(n)
　　　　w(0) = v
　　　　For i = 1 To n
　　　　　　If Not IsEmpty(.Cells(i, 1)) Then
　　　　　　　　cnt = cnt + 1
　　　　　　　　w(cnt) = .Rows(i).Value
　　　　　　End If
　　　　Next
　　End With
　　ReDim Preserve w(cnt)
'　　With Application
'　　　　z = .Transpose(.Transpose(w))
'　　End With
'　　Range("F1").Resize(cnt + 1, x).Value = z
　　Range("F1").Resize(cnt + 1, x).FormulaArray = w
End Sub

ジャグ配列というより、「多段階配列」という認識をしておけば良いと思います。
wの各要素が配列なので、そのままValueではセットできません。
FormulaArrayプロパティを使うか、Transposeを介して二次元配列に整理し直してセットします。
ただし、セルにセットできるのは各要素が一次元配列か、最初の次元が単一の二次元配列の場合です。
乱暴な言い方をすれば、「多段階配列」を立体的な配列と捉えてみてください。
そのままではセル範囲のような平面的な行列にセットできないという事ではないでしょうか。

ついでに参考コード。[ローカルウィンドウ]を活用して配列の構造の違いを把握しておいたほうが良いでしょう。
Sub test5()
　　Dim w(1), x, y

　　Cells.ClearContents
　　Range("A1:C2").Value = [{11,12,13;21,22,23}]
　　w(0) = Range("A1:C1").Value
　　w(1) = Range("A2:C2").Value
　　With Application
　　　　y = .Transpose(w)
　　　　x = .Transpose(.Transpose(w))
　　End With
　　Stop 'ここで[ローカルウィンドウ]確認。
　　Range("E1").Resize(UBound(y, 1), UBound(y, 2)).Value = y
　　Range("I1").Resize(UBound(x, 1), UBound(x, 2)).Value = x
　　Range("M1").Resize(UBound(w) + 1, UBound(w(0), 2)).Value = w
　　Range("M4").Resize(UBound(w) + 1, UBound(w(0), 2)).FormulaArray = w
End Sub

Sub test6()
　　Dim x1, x2　　　　　　　　　　 '一次元配列
　　Dim xx, yy, xy　　　　　　　　 '二次元配列
　　Dim v1(1), v2(1), v3(1), vv(1) '一次元配列
　　Dim w1, w2, w3, ww, z(1, 1), w '二次元配列

　　Cells.ClearContents
　　Range("A1:D2").Value = [{11,12,13,14;21,22,23,24}]

　　x1 = Array(11, 12, 13, 14)
　　x2 = Array(21, 22, 23, 24)
　　xx = Range("A1:D1").Value
　　yy = Range("A1:A2").Value
　　xy = Range("A1:D2").Value

　　v1(0) = x1
　　v1(1) = x2
　　Range("F1:I2").Formula = v1
　　Range("F5:I6").FormulaArray = v1
　　w1 = Application.Transpose(v1)
　　Range("F9").Resize(UBound(w1, 1), UBound(w1, 2)).Value = w1
　　Cells.ClearContents

　　v2(0) = xx
　　v2(1) = xx
　　Range("F1:I2").Value = v2
　　Range("F5:I6").FormulaArray = v2
　　w2 = Application.Transpose(v2)
　　Range("F9").Resize(UBound(w2, 1), UBound(w2, 2)).Value = w2
　　Cells.ClearContents

　　'以降はエラー
　　v3(0) = yy
　　v3(1) = yy
　　Range("F1:I2").Value = v3
　　Range("F5:I6").FormulaArray = v3
　　w3 = Application.Transpose(v3)

　　vv(0) = xy
　　vv(1) = xy
　　ww = Application.Transpose(vv)

　　z(0, 0) = x1
　　z(0, 1) = x2
　　z(1, 0) = x1
　　z(1, 1) = x2
　　w = Application.Transpose(z)
End Sub

お礼

> wの各要素が配列なので、そのままValueではセットできません。
> FormulaArrayプロパティを使うか、Transposeを介して二次元配列に整理し直してセットします。

なんとなくですが、理解しました。
FormulaArrayプロパティ、また新しい呪文を覚えました。
一応以下のようにしました。
Sub test5()
Dim x As Long
Dim n As Long
Dim i As Long
Dim cnt As Long
Dim z
x = 4
cnt = 0
With Range("A1").CurrentRegion.Resize(, x)
n = .Rows.Count
MsgBox n
ReDim w(n)
For i = 1 To n
If Not IsEmpty(.Cells(i, 1)) Then
w(cnt) = .Rows(i).Value
cnt = cnt + 1
End If
Next
End With
ReDim Preserve w(cnt - 1)
Range("F1").Resize(cnt, x).FormulaArray = w
End Sub
今日から数日、旅行に出ますので帰ってからじっくり勉強しようと思います。
end-uさま、遅い時間までほんとうに有難うございました。

回答No.5

end-u

念の為追記しておきます。
FormulaArrayプロパティを使って、一応はできますし、
2000で配列制限に引っ掛かる時、簡略化できるメリットはあります。
でもセル書き込みの効率は格段に落ちます。

VBAコーディングについてシンプルなものがイコール効率的とは限りません。
その点を理解した上で最適な手法を選択してください。

Option Explicit
'---------------------------------------------------------------------
Sub test()
　　Const rn As Long = 1000
　　Const cn As Long = 4
　　Dim i As Long
　　Dim t As Single
　　Dim w(1 To rn)

　　With Sheets.Add.Cells(1).Resize(rn, cn)
　　　　.Formula = "=ADDRESS(ROW(),COLUMN(),4)"
　　　　.Value = .Value
　　　　For i = 1 To rn
　　　　　　w(i) = .Rows(i).Value
　　　　Next
　　End With
　　t = Timer
　　test1 w
　　Debug.Print Timer - t
　　t = Timer
　　test2 w
　　Debug.Print Timer - t
　　t = Timer
　　test3 w
　　Debug.Print Timer - t
End Sub
'---------------------------------------------------------------------
Sub test1(w)
　　Dim z

　　With Application
　　　　z = .Transpose(.Transpose(w))
　　End With
　　Sheets.Add.Cells(1).Resize(UBound(z, 1), UBound(z, 2)).Value = z
End Sub
'---------------------------------------------------------------------
Sub test2(w)
　　Sheets.Add.Cells(1) _
　　　　　.Resize(UBound(w, 1), UBound(w(1), 2)).FormulaArray = w
End Sub
'---------------------------------------------------------------------
Sub test3(w)
　　Dim i As Long
　　Dim j As Long
　　Dim x As Long
　　Dim y As Long

　　y = UBound(w, 1)
　　x = UBound(w(1), 2)
　　ReDim z(1 To y, 1 To x)
　　For i = 1 To y
　　　　For j = 1 To x
　　　　　　z(i, j) = w(i)(1, j)
　　　　Next
　　Next
　　Sheets.Add.Cells(1).Resize(y, x).Value = z
End Sub

お礼

end-uさま、締め切った後までご指導いただき有難うございます。
先ほど戻ってまいりました。
さっそく試したところ、おっしゃる通りFormulaArrayだと随分遅くなるんですね、おどろきました。
ほんとにシンプルなものが効率的とは限らないんですね。
ご指導有難うございました。

回答No.3

end-u

>で、なぜ2度Transposeしているのでしょうか？
ぇぇー…
試してみればわかるでしょう？^ ^;
Sub test3()
　　Dim w(1), x, y

　　w(0) = Range("A1:D1").Value
　　w(1) = Range("A4:D4").Value
　　With Application
　　　　y = .Transpose(w)
　　　　x = .Transpose(.Transpose(w))
　　End With
　　Stop 'ここで[ローカルウィンドウ]確認。
　　Range("F1").Resize(UBound(y, 1), UBound(y, 2)).Value = y
　　Range("K1").Resize(UBound(x, 1), UBound(x, 2)).Value = x
End Sub

お礼

ありがとうございます。
いや、一回では行列が逆転するから２回Transposeしたのは分かるんです。
でも、だったら一回もしなくともいいのじゃないかと思ったんです。
だけど一回もTransposeしないとエラーになります・・・・。
きっと基本的なことなのでしょうが、そこが分からないのです。

回答No.2

end-u

>でも、これは取り込み先の行数が未定な場合、動的配列には出来ないんですよね？
できますよ。
ReDim Preserve で追加していってもいいですが
Sub pre()
　　Dim v

　　v = Array("A", "B", "C", "D")
　　Call test2(v)
End Sub

Sub test2(v)
　　Dim x　 As Long
　　Dim n　 As Long
　　Dim i　 As Long
　　Dim cnt As Long
　　Dim z

　　x = UBound(v) - LBound(v) + 1
　　With Range("A1").CurrentRegion.Resize(, x)
　　　　n = .Rows.Count
　　　　ReDim w(n)
　　　　w(0) = v
　　　　For i = 1 To n
　　　　　　If Not IsEmpty(.Cells(i, 1)) Then
　　　　　　　　cnt = cnt + 1
　　　　　　　　w(cnt) = .Rows(i).Value
　　　　　　End If
　　　　Next
　　End With
　　ReDim Preserve w(cnt)
　　With Application
　　　　z = .Transpose(.Transpose(w))
　　End With
　　Range("F1").Resize(cnt + 1, x).Value = z
End Sub

要素数の最大枠は取れるけど、格納される有効数が流動的な場合は
こんな感じで、最後に Preserve で格納数だけに縮小してTransposeできます。

お礼

有難うございます。以下のようにして思ったように出来ました。

Sub test4()
Dim x As Long
Dim n As Long
Dim i As Long
Dim cnt As Long
Dim z
x = 4
cnt = 0
With Range("A1").CurrentRegion.Resize(, x)
n = .Rows.Count
ReDim w(n)
For i = 1 To n
If Not IsEmpty(.Cells(i, 1)) Then
w(cnt) = .Rows(i).Value
cnt = cnt + 1
End If
Next
End With
ReDim Preserve w(cnt - 1)
With Application
z = .Transpose(.Transpose(w))
End With
Range("F1").Resize(cnt, x).Value = z
End Sub

最後に一つ教えていただけませんか？
z = .Transpose(.Transpose(w))
で、なぜ2度Transposeしているのでしょうか？

回答No.1

end-u

別に不細工とも思いませんが、例示が適切でないかもしれません？
安易なアドバイスで良ければ
Const n As Long = 4
Dim j　 As Long
Dim v

v = Range("A1").Resize(4, n).Value
ReDim w(1 To 2, 1 To n)
For j = 1 To n
　　w(1, j) = v(1, j)
　　w(2, j) = v(4, j)
Next
Range("F1").Resize(2, n).Value = w

こんな方針で配列に一括取得、書き出し用配列へ移行して、一括で書き出し...でいいような気もします。
特に2000ではTranspose時、配列要素数制限ありますからLoop処理のほうが適しているかも。

他には、知ってたら何かの時に使えるかもしれないというレベルですが、ジャグ配列を使う例。
Sub pre()
　　Dim v

　　v = Array("A", "B", "C", "D")
　　Call test(v)
End Sub

Sub test(v)
　　Dim n As Long
　　Dim w(1), x

　　n = UBound(v) - LBound(v) + 1
　　w(0) = v
　　w(1) = Range("A4").Resize(, n).Value
　　With Application
　　　　x = .Transpose(.Transpose(w))
　　End With
　　Range("F1").Resize(2, n).Value = x
End Sub
配列に配列を格納してTransposeで２次元配列にして書き出し。

お礼

ありがとうございます。
不細工と感じたのは、1行目はRange("A1:D1").Valueでデータを簡単に取得できるのに、追加した4行目はFor Nextで一個ずつまわしたからです。
でも一度に配列に取り込んで、配列と配列同士でループ処理する方法、勉強になりました。
また、後者の方は、先だってお教えいただいた、

* 配列に 255 文字を超える要素を含めることはできません。
* 配列に Null 値を含めることはできません。
* 配列内の要素数が 5461 を超えることはできません。

に該当しなければ、本質問の例なら

Sub test02()
Dim n As Long
Dim w(1), x
n = 4
w(0) = Range("A1").Resize(, n).Value
w(1) = Range("A4").Resize(, n).Value
With Application
x = .Transpose(.Transpose(w))
End With
Range("F1").Resize(2, n).Value = x
End Sub

でいけました。
でも、これは取り込み先の行数が未定な場合、動的配列には出来ないんですよね？