VBA100本ノック 11本目:セル結合の警告

こちらで公開されている、100本ノックに挑戦。
www.excel-ubara.com
素晴らしい教材を公開いただき、ありがとうございます。

上記リンク先から、問題文を転載。
f:id:Infoment:20220116144550p:plain

100本ノックも1割を過ぎて、だんだん難しくなってきた印象。
まず、セルが結合されているか否かは、MergeCellsプロパティで確認する。

Rangeオブジェクト.MergeCells

に対し、結合されていればTrueを、結合されていなければFalseを返す。

結合されていればコメントを追加するわけだが、例えばA1~A3が結合されて
いるとき、A1以外にコメントを追加しようとするとエラーになる。

以上を踏まえて作成したのがこちら。

Sub VBA_100Knock_011()
    Dim r As Range
        For Each r In Range("A1:C11")
            ' セルが結合されているか否かの確認。
            If r.MergeCells Then
                ' 結合セルの一番左上のセルであるか否かの確認。
                ' それ以外のセルにコメントを追加しようとすると
                ' エラーになるため。
                If r.Address = r.MergeArea.Cells(1).Address Then
                    Add_Comment r
                End If
            End If
        Next
End Sub

コメントを追加する部分は、切り出して別にしてみた。

Sub Add_Comment(target_range As Range)
    ' コメントを追加。
    With target_range
        .AddComment
        .Comment.Text Text:="セルの結合はお控えください"
    End With
    
    ' コメントのフォント調整。
    With target_range.Comment.Shape.TextFrame.Characters.Font
        .Name = "メイリオ"
        .Size = 10
        .Bold = False
    End With
    
    ' コメントのサイズを自動調整。
    target_range.Comment.Shape.TextFrame.AutoSize = True
End Sub


解答を実行した結果がこちら。
今回は解り易さのため事前に、結合セルを黄色で塗りつぶし済み。
f:id:Infoment:20220116151730g:plain

※冒頭リンク先の解答例および解説も、ぜひご一読ください。

参考まで。