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

公開日：2020-10-29　最終更新日：2021-02-22

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

セル結合されているセルにコメントで警告文を出す問題です。

ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。

マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。

出題

出題ツイートへのリンク

#VBA100本ノック 11本目
11…同じ数字が並んでいる、これは結合したのか、、、

画像のようにシートにはところどころにセル結合があります。
これは放置しておく訳にはいきません。
セル結合されているセルには、メモ（旧コメント）で警告文を出しましょう。
※シートは任意、警告文はご随意に

サンプルファイルです。
https://excel-ubara.com/vba100sample/VBA100_11.xlsm
https://excel-ubara.com/vba100sample/VBA100_11.zip

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

セル結合されているかはRangeオブジェクトのMergeCellsプロパティで判断します。
結合されている範囲はMergeAreaで取得します。
コメントの追加は結合範囲の先頭セルに入れます。
結合範囲の他のセルに入れても問題ありませんが、少々無駄な処理になってしまいます。


  
    
      Sub VBA100_11_01()

　　Dim ws As Worksheet

　　Set ws = ActiveSheet

　　Dim rng As Range

　　For Each rng In ws.Range("A1").CurrentRegion

      　　　　If rng.MergeCells Then

      　　　　　　If rng.Address = rng.MergeArea(1).Address Then

　　　　　　　　If Not rng.Comment Is Nothing Then

　　　　　　　　　　rng.ClearComments

　　　　　　　　End If

　　　　　　　　rng.AddComment "セル結合ダメ！"

　　　　　　　　rng.Comment.Shape.TextFrame.AutoSize = True

　　　　　　　　rng.Comment.Visible = True

　　　　　　End If

　　　　End If

　　Next

End Sub

先のVBAではCurrentRegionにしましたが、シート全体ならUsedRangeになるでしょう。
しかし、使用セル範囲が大きいと膨大な時間がかかってしまいます。
記事補足では、Findを使って結合セルを見つけるVBAを掲載しました。
また、ちょっお遊びになりますが、コメントのレイアウトも変更しています。

補足

先のVBAの結果

Findメソッドで結合セルを見つけて処理

※このVBAでも、XFD1048576まで使っていたら、とても時間がかかります。


  
    
      Sub VBA100_11_02()

　　Dim MergeMsg As String

　　MergeMsg = "セル結合なんて" & Chr(10) & "信じられない！"

　　

　　Dim ws As Worksheet

　　Set ws = ActiveSheet

　　

　　Application.FindFormat.Clear

　　Application.FindFormat.MergeCells = True

　　

      　　Dim rng As Range, firstAddress As String

      　　'Countはオーバーフローしてしまうので

      　　Set rng = ws.UsedRange(ws.UsedRange.CountLarge)

　　

　　Application.ScreenUpdating = False

　　

　　Do
　　　　Set rng = ws.UsedRange.Find(What:="", _

　　　　　　　　　　　　　　　　　　After:=rng, _

　　　　　　　　　　　　　　　　　　LookIn:=xlValues, _

　　　　　　　　　　　　　　　　　　SearchFormat:=True)

　　　　

　　　　If rng Is Nothing Then

　　　　　　Exit Do

　　　　End If

　　　　If rng.Address = firstAddress Then

　　　　　　Exit Do

　　　　End If

　　　　If firstAddress = "" Then

　　　　　　firstAddress = rng.Address

　　　　End If

　　　　

　　　　If rng.MergeCells Then

　　　　　　If rng.Address = rng.MergeArea(1).Address Then

　　　　　　　　Call setComment(rng, MergeMsg)

　　　　　　End If

　　　　End If

　　Loop

　　

　　Application.ScreenUpdating = True

End Sub


Sub setComment(ByVal rng As Range, _

　　　　　　　 ByVal msg As String)

　　Dim c As Comment

　　Set c = rng.Comment

　　

　　If Not c Is Nothing Then

　　　　If c.Shape.AlternativeText <> msg Then

　　　　　　Exit Sub '元からあったコメント

　　　　End If

　　　　c.Delete

      　　End If

      　　

　　Set c = rng.AddComment(msg)

　　c.Visible = True

　　c.Shape.AutoShapeType = msoShape32pointStar

　　c.Shape.Fill.ForeColor.RGB = vbRed

'　　c.Shape.TextFrame2.AutoSize = True 'このタイプには無効らしい

　　c.Shape.Width = 160 'サイズは適当です

　　c.Shape.Height = 55

　　With c.Shape.TextFrame.Characters.Font

　　　　.Size = 11

　　　　.Bold = True

　　　　.Color = vbWhite

　　End With

　　

　　'このVBAで作ったコメントかの判定に使ってみました。

      　　c.Shape.AlternativeText = msg

End Sub

これは、検索と置換の書式で検索する機能です。

この検索機能を使ったVBAになります。
ただし、通常はFindを繰り返す場合はFindNextを使うのですが、
FindNextは書式検索に対応していないので、開始セルをずらしながらFindを繰り返す必要があります。

このVBAで追加したコメントは毎回作成し直しますが、元々あったコメントはそのままにしています。
この判定に、AlternativeTextを使ってみましたが、これを使用したことに特に意味はありません。
本来のTextが同じならという判定でも変わりません。

結果は以下のようになります。

サイト内関連ページ

第85回．結合セルの扱い｜VBA入門

・セル結合に関する、メソッド・プロパティ・セル結合のマクロVBA使用例・セル結合時の値消去・指定セル範囲に結合セルが存在するか判定するマクロVBA ・セル結合時のOffsetとResizeの注意点

第94回．コメント（Comment）｜VBA入門

・コメント（Comment）に関する各種オブジェクト・コメント（Comment）の挿入・コメント（Comment）の削除・コメント（Comment）の編集・コメント（Comment）実践例

同じテーマ「VBA100本ノック」の記事

8本目：点数の合否判定

・出題・頂いた回答・解説・補足・サイト内関連ページ

9本目：フィルターコピー

・出題・頂いた回答・解説・補足・サイト内関連ページ

10本目：行の削除

・出題・頂いた回答・解説・補足・サイト内関連ページ

11本目：セル結合の警告
12本目：セル結合を解除

・出題・頂いた回答・解説・補足・サイト内関連ページ

13本目：文字列の部分フォント

・出題・頂いた回答・解説・補足・サイト内関連ページ

14本目：社外秘シート削除

・出題・頂いた回答・解説・補足・サイト内関連ページ

15本目：シートの並べ替え

・出題・頂いた回答・解説・補足・サイト内関連ページ

16本目：無駄な改行を削除

・出題・頂いた回答・解説・補足・サイト内関連ページ

17本目：重複削除（ユニーク化）

・出題・頂いた回答・解説・補足・サイト内関連ページ

18本目：名前定義の削除

・出題・頂いた回答・解説・補足・サイト内関連ページ

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.RangeとCellsの使い方｜VBA入門
4.ひらがな⇔カタカナの変換｜エクセル基本操作
5.繰り返し処理（For Next)｜VBA入門
6.変数宣言のDimとデータ型｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.Findメソッド（Find,FindNext,FindPrevious）｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
11本目：セル結合の警告

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

VBA練習問題
VBA100本ノック 11本目：セル結合の警告

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