半角チルダ

ExcelVBA、その他。
覚え書きや、補足資料などのスクラップブック。
end-u(1037781)

■ジャグ配列をシートに書き込む

2009-06-30 22:00:00 | 雑記
ジャグ配列といっても、単純なケースでの話。



多段階配列、いわゆる配列の配列なのでそのままワークシートに書き込む事はできません。
でも1次元配列の中に格納されている配列が1次元配列か、最初の次元が単一の2次元配列の時、
かつ、中の配列の要素数が一定の場合に限りますが、以下のように書き込みできます。

Sub sample()
  Dim r As Range
  Dim i As Long
  Dim aryX(1)
  Dim aryY(1)
  Dim x(2)
  Dim y(0, 2)

  For i = 0 To 2
    x(i) = i
    y(0, i) = i
  Next
  For i = 0 To 1
    aryX(i) = x
    aryY(i) = y
  Next

  Stop
  Set r = Range("A1").Resize(2, 3)

  'Transpose関数
  With WorksheetFunction
    r.Value = .Transpose(.Transpose(aryX))
    r.ClearContents
    r.Value = .Transpose(.Transpose(aryY))
  End With

  'FormulaArrayプロパティ
  r.ClearContents
  r.FormulaArray = aryX
  r.ClearContents
  r.FormulaArray = aryY

  Set r = Nothing
End Sub



前述条件のような単純な多段階配列の場合、
ワークシートTranspose関数を使って2次元配列に整理し直す事ができます。
また、FormulaArrayプロパティを使う事によって配列のままワークシートに書き込む事ができます。
よく見かけるのはTransposeを2回使う手法ですね。
FormulaArrayプロパティの方は使えない事はないけど、激遅なので使わないほうが良いです。
ジャグ配列というと、DictionaryのItemに配列をセットするパターンにも繋がるので、ちょっとDictionaryを使ってみた計測コード。

Option Explicit

Sub test()
  Const rn As Long = 1000
  Const cn As Long = 5
  Dim dic As Object
  Dim i  As Long
  Dim j  As Long
  Dim n  As Long
  Dim tmp(1 To cn)
  Dim t As Single

  Set dic = CreateObject("scripting.dictionary")
  For i = 1 To rn
    For j = 1 To cn
      n = n + 1
      tmp(j) = n
    Next
    dic(i) = tmp
  Next

  t = Timer
  With Application
    Sheets.Add.Cells(1).Resize(rn, cn).Value = _
              .Transpose(.Transpose(dic.items))
  End With
  Debug.Print "Transpose", Timer - t

  t = Timer
  Sheets.Add.Cells(1).Resize(rn, cn).FormulaArray = dic.items
  Debug.Print "FormulaArray", Timer - t

  t = Timer
  Sheets.Add.Cells(1).Resize(rn, cn).Value = AryLoop(dic.items)
  Debug.Print "AryLoop", Timer - t
End Sub
'---------------------------------------------------------------------
Function AryLoop(Ary)
  Dim Lx As Long
  Dim Ly As Long
  Dim Ux As Long
  Dim Uy As Long
  Dim i As Long
  Dim j As Long

  Ly = LBound(Ary)
  Uy = UBound(Ary)
  Lx = LBound(Ary(Ly))
  Ux = UBound(Ary(Ly))

  ReDim v(Ly To Uy, Lx To Ux)
  For i = Ly To Uy
    For j = Lx To Ux
      v(i, j) = Ary(i)(j)
    Next
  Next
  AryLoop = v
End Function

1,000×10配列で
Transpose      0.046875 
FormulaArray   4.234375 
AryLoop        0.046875 
こんな結果です。[winXPsp2/xl2003sp3]

Comment   この記事についてブログを書く
  • Twitterでシェアする
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする
« ■Sheet上MSForms.TextBoxイベ... | TOP | ■Worksheet MSForms.ListBox ... »
最新の画像もっと見る

Recent Entries | 雑記