[[20210812224609]] 『VBA 複数の配列をまとめる』(初心者) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『VBA 複数の配列をまとめる』(初心者)

複数のシートのA〜J列までに値が入ってます
行数はシートにより異なる(表の見出し行は無し)

これを一つのシートにまとめたいのですが、各シートの値を配列に格納して、それを1つの配列に合体して、最後に一発でセルに出力したいのですが、やり方がわかりません。
現在はコピペするようなコードで、特に問題はありませんが、何だかスマートじゃない気がして

< 使用 Excel:Office365、使用 OS:Windows10 >


 提示のケースだと、2次元配列への格納を想定していらっしゃるかと思いますが、
 2次元配列を行方向へ「合体」させるのはそれなりに手間なので、特別「最後に一発」で出力する理由がなければ、
 シート毎に配列に格納→都度最下行から書き出しの繰返しの方が分かり易い気もします。
  「VBA  2次元配列 結合」とか「ReDim Preserve Transpose  VBA」とかで検索すると、ヒントが得られるかもしれません。
(#) 2021/08/12(木) 23:34

 >何だかスマートじゃない気がして
 なぜそう思ったのか興味があります。
 気のせいということはないですか?

 今のPCはメモリに余裕がある場合が多いので、
 書き出し用の配列は最初に全部入るだけのサイズを用意しても大丈夫だと思います
 あとは地道に配列から配列への代入を繰り返します 

    Sub sample()
      Dim sh As Worksheet
      Dim ND As Long, r As Long, c As Long
      Dim outbuf(), buf
      ND = 0
      For Each sh In Worksheets(Array("Sheet1", "Sheet2", "Sheet3"))
          With sh
             ND = ND + sh.Cells(.Rows.Count, "A").End(xlUp).Row
          End With
      Next
      ReDim outbuf(1 To ND, 1 To 10)
      r = 0
      For Each sh In Worksheets(Array("Sheet1", "Sheet2", "Sheet3"))
          With sh
              buf = sh.Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 10).Value
          End With
          For i = 1 To UBound(buf, 1)
              For j = 1 To 10
                  outbuf(r + i, j) = buf(i, j)
              Next
          Next
          r = r + i - 1
      Next
      With Worksheets("Sheet4")
          .Cells(1, 1).Resize(ND, 10).Value = outbuf
      End With
    End Sub
(´・ω・`) 2021/08/13(金) 00:02

 ちなみに、コードの短さ、わかりやすさで言えば、
 #さんの 
 >シート毎に配列に格納→都度最下行から書き出しの繰返しの方が分かり易い気もします。
 の方がよろしいかと思います。
 というか配列に読み込む必要もないことに気づきました

    Sub sample2()
      Dim sh As Worksheet
      Dim iR As Long, NR As Long
      iR = 1
      For Each sh In Worksheets(Array("Sheet1", "Sheet2", "Sheet3"))
          NR = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
          Worksheets("Sheet4").Cells(iR, 1).Resize(NR, 10).Value = sh.Cells(1, 1).Resize(NR, 10).Value
          iR = iR + NR
      Next
    End Sub
(´・ω・`) 2021/08/13(金) 00:44

現在はコピペするようなコードで、特に問題はありませんが、何だかスマートじゃない気がして

妄想です。
素直なコピペの方が速いです。
(幻覚です。) 2021/08/13(金) 02:53


 >素直なコピペの方が速いです
 確かめてみましょう

    Sub test()
       For i = 0 To 9
          Worksheets.Add after:=Worksheets(Worksheets.Count)
          With ActiveSheet
             .Name = "from" & i
             .Cells(1, 1).Resize(5000 + 5000 * Rnd, 10).Formula = "=""from" & i & "-"" & Row() & ""-"" & Column()"
          End With
       Next
       Worksheets.Add before:=Worksheets("from0")
       ActiveSheet.Name = "copytest"

       With Worksheets("copytest")

          .Cells.ClearContents
          t = Timer
          Call sample2
          Debug.Print Timer - t

          .Cells.ClearContents
          t = Timer
          Call sample3
          Debug.Print Timer - t

       End With

    End Sub

    Sub sample2()
      Dim sh As Worksheet
      Dim iR As Long, NR As Long
      iR = 1
      For Each sh In Worksheets(Array("from0", "from1", "from2", "from3", "from4", "from5", "from6", "from7", "from8", "from9"))
          NR = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
          Worksheets("copytest").Cells(iR, 1).Resize(NR, 10).Value = sh.Cells(1, 1).Resize(NR, 10).Value
          iR = iR + NR
      Next
    End Sub

    Sub sample3()
      Dim sh As Worksheet
      Dim iR As Long, NR As Long
      iR = 1
      For Each sh In Worksheets(Array("from0", "from1", "from2", "from3", "from4", "from5", "from6", "from7", "from8", "from9"))
          NR = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
          sh.Cells(1, 1).Resize(NR, 10).Copy Worksheets("copytest").Cells(iR, 1)
          iR = iR + NR
      Next
    End Sub

 結果
 sample2 => 5.941406 
 sample3 => 1.359375 
 コピーの方が4倍くらい速いですね。
(´・ω・`) 2021/08/13(金) 06:30

たくさんの回答ありがとございました。
配列に格納して、都度書き出しにしました。

測定しても速度が
大きく変わることはありませんでした。

確かに幻覚だったかも、、

(初心者) 2021/08/13(金) 23:38


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.