Excel VBAで結合されたセルを参照する

┌─┬─────┬────┬────────┬────────────┐
│　│　　Ａ　　│　Ｂ　　│　　　Ｃ　　　　│　　　　　Ｄ　　　　　　│
├─┼─────┴────┴────────┴────────────┤
│１│　　　　　　　　　　　　　ネコ科　　　　　　　　　　　　　　　　│
├─┼─────┬──────────────────────────┤
│２│チーター族│　　　　　　　　カラカル族　　　　　　　　　　　　　│
├─┼─────┼────┬────────┬────────────┤
│３│チーター　│カラカル│ボルネオヤマネコ│アジアゴールデンキャット│
└─┴─────┴────┴────────┴────────────┘

Excelで上記のような表が作成されていて、

ネコ科-チーター族-チータ
…
……
ネコ科-カラカル族-アジアゴールデンキャット

のような文字列のリストを生成したいとしよう。

VBAでマクロを書けばいいのだが、単純につぎのように書くとうまくいかない。

Public Sub ListGenerate()
    Dim row As Integer
    Dim col As Integer
    Dim line As String
    
    Dim fso As New FileSystemObject
    Dim stream As TextStream
    
    On Error GoTo ERR_HANDLE
    
    Set file = New FileSystemObject
    Set stream = file.CreateTextFile(ThisWorkbook.Path & "\" & ActiveSheet.Name & ".txt", True, False)
    With stream
    
    For col = 1 To 4
        line = ""
        For row = 1 To 3
            ' 科→族→名称の順に文字列を結合する
            line = line & Cells(row, col)
            
            If (row <> 3) Then
                ' 最後でなければハイフンで区切る
                line = line & "-"
            End If
        Next
        .WriteLine (line)
    Next
    .Close
    Exit Sub
    
ERR_HANDLE:
    .Close
    End With
End Sub

上記の出力結果は次のようになってしまう。

ネコ科-チーター族-チーター
-カラカル族-カラカル
--ボルネオヤマネコ
--アジアゴールデンキャット

これは、結合されているセルがあるため。結合してあるセルの内容を取得するには、MergeAreaプロパティを利用する。MergeAreaプロパティは結合された「範囲」が取得できる(Rangeオブジェクト)。結合されたセルで内容が取得できるのは、行番号・列番号が一番若いセルのみであるため、RangeオブジェクトのOffsetプロパティを使用して次のように結合されたセルの内容を取得できる。

Cells(row, col).MergeArea.Offset(0, 0)

と、いうわけで書き直したソースが以下。

Public Sub ListGenerate()
    Dim row As Integer
    Dim col As Integer
    Dim line As String
    
    Dim fso As New FileSystemObject
    Dim stream As TextStream
    
    On Error GoTo ERR_HANDLE
    
    Set file = New FileSystemObject
    Set stream = file.CreateTextFile(ThisWorkbook.Path & "\" & ActiveSheet.Name & ".txt", True, False)
    With stream
    
    For col = 1 To 4
        line = ""
        For row = 1 To 3
            ' 科→族→名称の順に文字列を結合する
            line = line & Cells(row, col).MergeArea.Offset(0, 0)
            
            If (row <> 3) Then
                ' 最後でなければハイフンで区切る
                line = line & "-"
            End If
        Next
        .WriteLine (line)
    Next
    .Close
    Exit Sub
    
ERR_HANDLE:
    .Close
    End With
End Sub

出力結果は

ネコ科-チーター族-チーター
ネコ科-カラカル族-カラカル
ネコ科-カラカル族-ボルネオヤマネコ
ネコ科-カラカル族-アジアゴールデンキャット