セルの結合等の書式がファイルごとに異なる場合の一覧表用の集計マクロ

Question

図のようなデータがexcelで複数存在する時に、指定の項目について抜き出し、
一覧表を作りたいと考えています。ただし、excelには以下のような特徴があります。

①項目ごとにセルが結合されている場合がある（図のように果物は2列、値段は1列等）

②①はexcelによって結合されているセル数が異なる（別のファイルでは果物は1列、値段は2列のものある）

③抽出セルの位置がファイルによって異なる（ファイルごとに項目名の始まるセルが異なる）

以上のような条件の時に、「果物」と「金額」だけを抽出できるようなマクロはどのように組めばよいでしょうか。

よろしくお願いいたします。

Answer 1

こんな感じになっているとき、

Sub 集積()
    抽出 Workbooks("Book1").Sheets(1).UsedRange
    抽出 Workbooks("Book2").Sheets(1).UsedRange
End Sub

Sub 抽出(ByRef pRng As Range)
    Dim rngCopyFrom As Range
    Dim rngCopyTo As Range

    With ThisWorkbook
        Set rngCopyFrom = .Sheets("Sheet2").Range("A1:B1")
        With .Sheets("Sheet1")
            Set rngCopyTo = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
        End With
    End With
    
    pRng.AdvancedFilter xlFilterCopy, , rngCopyFrom
    Set rngCopyFrom = rngCopyFrom.CurrentRegion.Offset(1)
    rngCopyFrom.Copy rngCopyTo
End Sub

こんな感じで、
フィルターオプションの機能で各対象ブックから抽出できそう。

列方向の結合は気にしなくてよさそう。

Answer 2

結合セルではデータは一番左上のセルに格納されていて、他のセルは空欄になります。
つまり途中に空欄があるデータのあつまりということなので、結合セルということを特別意識する必要はなくコーディングできます。

例えば下記のような感じです。セルが結合されても、されてなくても同じコードでOKです。

Public Sub Sample()
    Dim FruitRng As Range
    Set FruitRng = Range("1:1").Find("果物")
    If FruitRng Is Nothing Then Exit Sub

    Dim AmountRng As Range
    Set AmountRng = Range("1:1").Find("金額")
    If AmountRng Is Nothing Then Exit Sub
    
    Debug.Print "果物は" & FruitRng.Column & "列目です"
    Debug.Print "金額は" & AmountRng.Column & "列目です"    
    
    Do
        Set FruitRng = FruitRng.Offset(1)
        Set AmountRng = AmountRng.Offset(1)
        If FruitRng.Value = "" Then Exit Do
        Debug.Print FruitRng.Value & "の金額は" & AmountRng.Value
    Loop
End Sub

Answer 3

①項目ごとにセルが結合されている場合がある（図のように果物は2列、値段は1列等）
②①はexcelによって結合されているセル数が異なる（別のファイルでは果物は1列、値段は2列のものある）

MergeArea.Item(1)を参照することで、結合セル数にかかわらず値を取得することができます。
例

Debug.Print Range("A2").MergeArea.Item(1).Value
Debug.Print Range("D2").MergeArea.Item(1).Value

③抽出セルの位置がファイルによって異なる（ファイルごとに項目名の始まるセルが異なる）

簡易に対応するのであれば、位置を固定値で指定することになると思います。

例

' ファイル1の個数
Debug.Print wb1.Worksheets(1).Range("D2").MergeArea.Item(1).Value
' ファイル2の個数
Debug.Print wb2.Worksheets(1).Range("E2").MergeArea.Item(1).Value

集計対象のファイルがランダムで毎回決まったファイルを使用しなかったり、毎回書式が違っていたりする場合は、Find関数などで場所を探すことになるかと思いますが、面倒なのでサンプルはなし。
但しこの場合はヘッダーの文言は全ファイル統一されている必要があります。