Excelマクロで条件に沿って２次元配列を作成し、結果を別シートで統合したい

Question

マクロ初心者です。研究で画像処理をしています。

■やりたいこと
以下の構成のエクセルでMainシートから結果シートの結果を条件式で判定し、
該当する結果を下記「理想の出力」のようにまとめたい。

■エクセルの構成
・Main（結果を統合するシート）
・Result1.csv（結果１）
・Result2.csv（結果２）
（結果のシートは多数あり）

※ResultX.csvは下記のような構成

フレーム番号	フラグ(0or1)
0	0
1	0
2	0
3	1
4	1
5	0
6	1
7	0
...	...
（フレーム数は10000前後）

■条件式
フラグが0→1に変わったフレームの番号を取得する

■理想の出力
Mainシートに以下のようにまとめたい

シート名	フレーム番号
Result1.csv	3
Result1.csv	6
Result1.csv	20
Result2.csv	2
...	...

■現状
条件式の判定はできるようになりましたが、判定結果をMainシートに反映する方法がわからない

■現状のコード
条件に該当するフレームがいくつあるのかわからないため、可変長の配列にすべきと思うのですが、複数のFor分の設定、配列の作成がわからず、手が止まってしまいました。。

Sub sample1()
  Dim i,j As Long  '条件式による判定用
  Dim RowNum As Integer '結果のフレーム数
  Dim FlagFrame As() Long
  ReDim Preserve FlagFrame(1)

  Worksheets("Result1.csv").Activate
  RowNum = Cells(Rows.count,1).End(xlUp).Row

  For i = 1 To RowNum
    j = Cells(i,"B")
    k = Cells(i+1,"B")
    If j = 0 And k = 1 Then '条件式
      FlagFrame(l)= i
      Debug.Print i-1 & "フレームでフラグ切替検知"
    End If
  Next
End Sub

不明点や不足している情報などありましたらご指摘お願いします。

Comments

[tatsu99]

Excelのシート構成は、Main以外は全てResultX.csvと理解して良いですか。
フレーム番号=0のフラグが1の場合は、Mainシートに登録対象になりますか。それともなりませんか？

[shallow104]

①Excelのシート構成は、Main以外は全てResultX.csvと理解して良いですか。
→はい、認識の通りです。
②フレーム番号=0のフラグが1の場合は、Mainシートに登録対象になりますか。それともなりませんか？
→フレーム番号=0のフラグが1になることはないものと思って頂いて大丈夫です。

Answer 1

特に2次元配列は不要かと思います。
配列を使わない方法です。
前の値が０で今回の値が１なら、その行をMainに取り込みます。
Main,resultX.csvともに1行目は見出し行である前提です。

Option Explicit
Public Sub Main収納()
    Dim ms As Worksheet
    Dim ws As Worksheet
    Dim msRow As Long               'Mainシート行番号
    Set ms = Worksheets("Main")
    ms.Cells.ClearContents
    ms.Range("A1:B1").Value = Array("シート名", "フレーム番号")
    msRow = 2
    '全シート分設定
    For Each ws In Worksheets
        If ws.Name <> ms.Name Then          'Mainシートでないなら、シートの設定を行う
            Call Set1Sheet(ms, msRow, ws)
        End If
    Next
    MsgBox ("完了")
End Sub
'１シート分設定
Private Sub Set1Sheet(ByVal ms As Worksheet, ByRef msRow As Long, ByVal ws As Worksheet)
    Dim maxrow As Long
    Dim pval As Variant
    Dim wrow As Long
    maxrow = ws.Cells(Rows.Count, 1).End(xlUp).Row  'A列最終行取得
    pval = 1
    For wrow = 2 To maxrow
        If ws.Cells(wrow, "B").Value = 1 And pval = 0 Then          '前行が0でかつ現在行が1の場合
            ms.Cells(msRow, "A").Value = ws.Name                    'シート名
            ms.Cells(msRow, "B").Value = ws.Cells(wrow, "A").Value  'フレーム番号
            msRow = msRow + 1
        End If
        pval = ws.Cells(wrow, "B").Value                            '前行を記憶
    Next
End Sub

Answer 2

配列を使うなら、セル範囲をそのまま二次元配列に代入できるので、それを使うといいでしょう。
出力結果も２列なので、その配列に結果を上書きしていくと無駄がないです。

とりあえず Result1.csv の結果をMainに出力するサンプル。

Sub sample1()
    Dim ws As Worksheet
    Set ws = Worksheets("Result1.csv")
        
    Dim FlagFrame()
    FlagFrame = ws.Range("A1").CurrentRegion.Value
    
    Dim i As Long, j As Long
    j = 1
    For i = 1 To UBound(FlagFrame) - 1
        If FlagFrame(i, 2) = 0 And FlagFrame(i + 1, 2) = 1 Then
            FlagFrame(j, 2) = FlagFrame(i + 1, 1) '２列目にフレーム番号を代入
            FlagFrame(j, 1) = ws.Name             '１列目にシート名を代入
            j = j + 1
        End If
    Next
    
    Worksheets("Main").Cells(1, 1).Resize(j - 1, 2).Value = FlagFrame '配列をセル範囲に出力
End Sub

追記

ブックと同じフォルダーにCSVファイルがあり、それを読み込む場合のコード例

Public Sub sample()
    Dim outputCell As Range
    With Worksheets("Main")
        .Cells(1, 1).CurrentRegion.ClearContents
        .Range("A1:B1").Value = Array("シート名", "フレーム番号")
        Set outputCell = .Cells(2, 1) '出力セル
    End With

    Application.ScreenUpdating = False
    Dim fn As String
    fn = Dir(ThisWorkbook.Path & "\result*.csv")
    Do Until fn = ""
        With Workbooks.Open(fn)
            outputMain .Worksheets(1), outputCell
            .Close False
        End With
        fn = Dir()
    Loop
    Application.ScreenUpdating = True
End Sub

Sub outputMain(ws As Worksheet, ByRef outputCell As Range)
    Dim FlagFrame()
    FlagFrame = ws.Range("A1").CurrentRegion.Value
    Dim i As Long, j As Long
    For i = 1 To UBound(FlagFrame) - 1
        If FlagFrame(i, 2) = 0 And FlagFrame(i + 1, 2) = 1 Then
            j = j + 1
            FlagFrame(j, 2) = FlagFrame(i + 1, 1)
            FlagFrame(j, 1) = ws.Name
        End If
    Next
    outputCell.Resize(j, 2).Value = FlagFrame
    Set outputCell = outputCell.Offset(j)        '出力セルを次のセルに設定
End Sub

Comments

[shallow104]

回答ありがとうございます！
参考にさせていただきます！

Answer 3

2次元配列に入れてませんが、こんな感じで考えてみました。

Option Explicit
Sub Sample()
    ReadCSV "result1.csv"
    ReadCSV "result2.csv"
End Sub

Sub ReadCSV(fn As String)
    Dim main As Worksheet
    Dim r As Long
    Set main = ThisWorkbook.Worksheets("Main")
    main.Range("A1:B1").Value = Array("シート名", "フレーム番号")
    r = main.Cells(main.Rows.Count, 1).End(xlUp).Row + 1
    
    Dim wb As Workbook, ws As Worksheet
    Set wb = Workbooks.Open(fn)
    Set ws = wb.Worksheets(1)
    
    Dim i
    For i = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        If ws.Cells(i, 2).Value = 1 And ws.Cells(i - 1, 2).Value = 0 Then
            main.Cells(r, 1).Resize(, 2).Value = Array(fn, i)
            r = r + 1
        End If
    Next
    wb.Close False

End Sub

Sub Sample2()
    Dim f
    With CreateObject("Scripting.FileSystemObject")
        For Each f In .GetFolder(ThisWorkbook.Path).Files
            If LCase(f.Name) Like "result*.csv" Then ReadCSV f.Name
        Next
    End With
End Sub

Comments

[shallow104]

回答ありがとうございます！
ちなみに、 csvもfor文で読み込ませようとなると、どのようにすればよいでしょうか？

[jinoji]

Sample2 として追記してみました。