こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセル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

投稿日時 - 2009-06-26 11:15:18

QNo.5075801

困ってます

質問者が選んだベストアンサー

申し訳ない...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

投稿日時 - 2009-06-27 03:07:00

お礼

> 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さま、遅い時間までほんとうに有難うございました。

投稿日時 - 2009-06-27 11:07:39

ANo.4

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(5)

ANo.5

念の為追記しておきます。
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

投稿日時 - 2009-06-29 00:15:21

お礼

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

投稿日時 - 2009-07-03 00:02:37

ANo.3

>で、なぜ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

投稿日時 - 2009-06-26 22:24:54

お礼

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

投稿日時 - 2009-06-26 22:41:52

ANo.2

>でも、これは取り込み先の行数が未定な場合、動的配列には出来ないんですよね?
できますよ。
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できます。

投稿日時 - 2009-06-26 17:37:42

お礼

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

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しているのでしょうか?

投稿日時 - 2009-06-26 21:07:02

ANo.1

別に不細工とも思いませんが、例示が適切でないかもしれません?
安易なアドバイスで良ければ
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で2次元配列にして書き出し。

投稿日時 - 2009-06-26 15:21:35

お礼

ありがとうございます。
不細工と感じたのは、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

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

投稿日時 - 2009-06-26 17:03:24

あなたにオススメの質問