[[20221129164139]]　『複数ブックの値を2次元配列に格納する』（kisk）　ページの最後に飛ぶ

『複数ブックの値を2次元配列に格納する』（kisk）

VBA勉強中の初心者です。

複数ブックの行数が可変の範囲（列は固定）に入力されている文字列を一つの2次元配列に格納し、格納した値を取りまとめのブックに一括貼付けするコードを考えているのですがうまくいきません。

何かお知恵を拝借できればうれしいです。
よろしくお願いいたします。

～～（イメージ）～～
ブック1
　A1 B1 C1
　A2 B2 C2
　A3 B3 C3
　A4 B4 C4

ブック2
　あいう
　かきく
　さしす

ブック3
　a b c
　d e f
～～～～～～～～～～～

～～（仮コード）～～
Dim Mypath As String: Mypath = ThisWorkbook.Path & "\"
Dim Myxlsx As Variant: Mycsv = Dir(Mypath & "*.xlsx")
Dim arry As Variant
Dim UsedR As Long
Dim UsedC As Long

Do While Myxlsx <> ""

 Workbooks.Open (Mypath & Myxlsx)
 UsedR = ActiveSheet.UsedRange.Rows.Count
 UsedC = ActiveSheet.UsedRange.Columns.Count

 IF　条件式　then
  ReDim arry(1 To UsedC, 1 To UsedR)  '初期定義
 Else
  Redim arry(1 to Ubound(arry), 1 to Ubound(arry,2) + UsedR)　'2回目以降の定義
 End IF
 arry = WorksheetFunction.Transpose(ActiveSheet.UsedRange.Rows(1 & ":" & UsedR))
  Workbooks(Mycsv).Close Savechanges:=False
  Mycsv = Dir() 
Loop

～～～～～～～～～～～

（悩み）
・2つ目以降のブックの文字列を配列にうまく格納できない
・Redimの初期定義と、2回目以降の定義のIF分岐

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

 >複数ブックの行数が可変の範囲 
 を
 >一つの2次元配列に格納
 なぜそんなことをするんでしょうか

 「1つのブックのセル範囲をコピー先ブックに貼り付け」をブックの数だけ繰り返す
 のではなぜダメなんですか？

 それか、最初から
  ReDim arry(1 To Rows.Count, 1 To UsedC)
 としてはいかがでしょう
（´・ω・`） 2022/11/29(火) 17:19:01

ご返信ありがとうございます。

一つの配列に格納する理由は、単純に実行速度を上げたいからです。
記載したイメージでは少数の文字列ですが、実際に使用するデータは日毎に数千のデータが入力されており、それを毎月分処理することになります。そのようなデータを都度貼付けしていると処理にかなりの時間が掛かっていました。
また、質問には書いておりませんでしたが、ひとまとめにしたデータは不要箇所の削除すること（配列内かセル上かは未定）、必要データの抽出も想定しており、2次元配列にひとまとめにして操作するのが良いかなと考えた次第です。
（kisk） 2022/11/29(火) 17:44:27

多次元配列の場合、最後の次元のインデックスしか増やすことはできません。

セル範囲をValueを使って二次元配列に格納すると、配列(行, 列) となりますので、Redimで列数は増やせても、行数は増やせません。

ご希望のことは、各ブックのセル範囲を縦(行方向)に格納することだと思いますが、行を増やすことはできないので、Redimでは無理ということになります。

そもそも、複数の配列を一つにまとめるというメソッドもVBAではないので、1要素ずつループで回して代入していくしかないですので、高速化にはなりません。

それぞれのブックのセル範囲を、それぞれの配列に格納して、その配列で処理をして、
それをシートに代入していくという方法になると思います。
（hatena） 2022/11/29(火) 18:05:05

 開くブックの数にもよりますね
 数千個のブックがあるなら貼り付け回数も数千個になるので１つの配列で処理したほうが速いでしょうけど、
 ブックが数１０個なら目に見えるような速度向上はないと思います。
 一番時間かかるのは、ブックを開いたり閉じたりの処理だと思います。

 ま、好きにやればいいと思いますが、

 うまくいかない根本原因は、
 arry = WorksheetFunction.Transpose(ActiveSheet.UsedRange.Rows(1 & ":" & UsedR))
 ここで、arryを全部上書きしているからです。
 最後に開いたブックの値しかarryには入りません

 なので、hatenaさんが書いてるとおり、ブックの中身をいったん別の配列によみこんで
 配列→配列のコピーをしないといけないです。
 配列→配列のコピーは、２重ループになりますが、配列→シートの書き出しよりは速いと思いますけど
（´・ω・`） 2022/11/29(火) 18:37:41

 雰囲気としては、こんな感じ
 Sub sample()
    Dim wb As Workbook
    Dim arry(1 To Rows.Count, 1 To Columns.Count)
    Dim buf
    Dim r As LongLong, maxc As Long
    r = 0
    maxc = 0
    Mycsv = Dir(Mypath & "*.xlsx")
    Do While Myxlsx <> ""
        Set wb = Workbooks.Open(Myxlsx, ReadOnly:=True)
        buf = wb.ActiveSheet.UsedRange.Value
        For i = 1 To UBound(buf, 1)
            For j = 1 To UBound(buf, 2)
                arry(r + i, j) = buf(i, j)
            Next
        Next
        r = r + UBound(buf, 1)
        maxc = WorksheetFunction.Max(maxc, UBound(buf, 2))
        Mycsv = Dir
    Loop
    ThisWorkbook.ActiveSheet.Cells(1, 1).Resize(r, maxc).Value = arry
 End Sub
（´・ω・`） 2022/11/29(火) 18:47:17

コメント返信：

[ 一覧(最新更新順) ]

[[20221129164139]] 『複数ブックの値を2次元配列に格納する』（kisk） ページの最後に飛ぶ

[[20221129164139]]　『複数ブックの値を2次元配列に格納する』（kisk）　ページの最後に飛ぶ