Excel(エクセル)で図形(オブジェクト)内の文字列をVBAで検索～グループ化してても検索可～

2023年7月26日 2024年10月20日

中山テック代表

中山テック代表の中山です。

先日のExcel検索・置換についてのブログでオブジェクト（図形・オートシェイプ）が検索できないとお話しました。

VBAというプログラミングで図形を取得⇒テキスト検索することが可能であります。

ツールとして作成したので、どのように使用するか、何に気を付けてプログラミングしたかお話したいと思います。

楽天市場でデジタル機器も見つかる♪(PR)

そろそろふるさと納税で税金対策の時期ですよ♪(PR)

1 ツール
2 使い方
3 プログラミング
4 その他
5 YouTube
6 まとめ

ツール

上記アイコンをクリックし⇒「図形の文字列検索.xlsm」クリック⇒画面右「↓」アイコンをクリックするとダウンロードを開始します。

使い方

画像に記載した通りです。

パス、検索ワード、スタートボタン実行で検索が始まります。

※パスの一番後ろに「半角￥」を付与しないとエラーになります！注意！

Cドライブ⇒tmp配下にExcelを3つ置きました。

パスはここを指定します。

各ファイル中身は同じです。

Sheet2に「かきくけこ」と書かれたオブジェクトを配置してます。

※Sheet1は「あいうえお」、Sheet3は「さしすせそ」と入れてます

完了したら「おわり！」のダイアログが表示されます。

次に7行目から検索結果が表示されます。

図形の中に検索文字列があればオッケー！

何なら1文字「あ」と入れれば沢山引っかかることでしょう。

Excel関連記事(記事はまだまだ続きます)

プログラミング

ファイル取得、結果の見出し

Private Sub CommandButton1_Click()
    Dim ws As Worksheet         ' ワークシートループ用
    Dim counter As Long         ' 検索結果表示用カウンター
    Dim searchWord As String    ' 検索ワード
    Dim filePath As String      ' ファイルパス
    Dim fileName As String  ' ファイル名
    
    ' ファイル取得⇒①
    filePath = Range("C2")                      ' パス
    fileName = Dir(filePath & "*.xlsx")     ' ファイル一覧
    
    ' 見出し付与⇒②
    counter = 0
    Cells(counter + 6, 1) = "ファイル名"
    Cells(counter + 6, 2) = "シート名"
    Cells(counter + 6, 3) = "場所"
    Cells(counter + 6, 4) = "検索結果テキスト"

①はファイルパス、ファイル名を取得します。

パスはセルに自身で入力、ファイルはパス内の「XLSX」形式のファイル一覧を取得（Dir）。

※XLSファイルを開きたい場合はご自身で指定ください

②は検索結果の見出しを入れます。

セルはRangeとCells形式ですが、変数を使っているのでCellsが楽です。

Cells(行,列)で指定。

検索結果初期化、検索ワード取得

    ' 結果初期化処理⇒①

    For i = 7 To Cells(Rows.Count, 1).End(xlDown).Row
        If Cells(i, 1) = "" Then
            Exit For
        End If
        Cells(i, 1) = ""
        Cells(i, 2) = ""
        Cells(i, 3) = ""
        Cells(i, 4) = ""
    Next i
    
    ' 検索ワード取得⇒②

    searchWord = Range("C3").Text

①で初期化するのですがFor～の最後のCells～です。

xlDown＝Ctrl＋PgDnキーと同じです。つまり最下までループする命令になります。

ただし、空白行を確認したらループストップの命令を入れてますので、数が多くなければすぐ終わります。

②はセルが決まってるので「Range」でセルを指定してます。

グループ化検索、単一オブジェクトの検索処理

    ' パスからファイル取得
    Do While fileName <> "" ⇒①

        ' ファイルオープン
        Workbooks.Open filePath & fileName

            ' 全ワークシート検索
            For Each ws In Worksheets⇒②
                ' 1つ目のワークシートを検索
                For i = 1 To ws.Shapes.Count
                    ' オートシェイプを取得
                    With ws.Shapes(i)⇒③
                        ' グループがあるか検索
                        If .Type = msoGroup Then
                            ' グループ内オブジェクトテキスト検索
                            ' 1:グループオブジェクト、2:ファイル名、3:シート名、4:検索ワード、5：カウント
                            counter = childShapeLoop(ws.Shapes(i), fileName, ws.Name, searchWord, counter)⇒④

                        ' テキストがあるか検索
                        ElseIf .TextFrame2.HasText Then⇒⑤
                            ' 検索ワードと一致するか検索
                            If InStr(.TextFrame2.TextRange.Text, searchWord) Then⇒⑥
                                Cells(counter + 7, 1) = fileName
                                Cells(counter + 7, 2) = ws.Name
                                Cells(counter + 7, 3) = .TopLeftCell.Address
                                Cells(counter + 7, 4) = .TextFrame2.TextRange.Text
                                counter = counter + 1
                            End If
                        End If
                    End With
                Next i
            Next
        ' ファイルクローズ
        Workbooks(fileName).Close
        ' 次のファイルへ
        fileName = Dir()
    Loop
    MsgBox "おわり！"
End Sub

①では検索対象ファイルがなくなるまでループします。

今回は3ファイルあるので3回ループ、その後書類終了となります。

②では1ファイル内のシートをループします。

6シート分あるので6回ループします。

③ではワークシート内で取得したオートシェイプ（図形、オブジェクト）分ループします。

1オブジェクト分なので1回だけのループですが、複数件あればその分ループします。

④は追記ですが、グループ化された場合に別Functionを呼びだします。

グループにグループを重ねている場合があるので、自己Functionを呼びだします。

詳細は後述

⑤Text（文字列）があるかどうか判定します。

⑥ではInStrで検索ワードでオブジェクトのテキストがあるか判定します。

全体でファイル数×シート数×オブジェクト数分のループを行います。

多ければ多い程処理も重くなります。

グループ化された画像の中のオブジェクト、テキストを検索（2023/7/27追記）

Function childShapeLoop(motoShape As Shape, fileName As String, wsName As String, searchWord As String, counter As Long) As Long

   ' ある場合はオブジェクト1つ1つを解析
   For Each gShape In motoShape.GroupItems
       ' オブジェクトがさらなるグループかどうか判定
       If gShape.Type = msoGroup Then
           childShapeLoop = childShapeLoop(motoShape, fileName, wsName, searchWord, counter)⇒①

       ' オブジェクトにテキストがあるか検索
       ElseIf gShape.TextFrame2.HasText Then
           ' 検索ワードと一致するか検索
           If InStr(gShape.TextFrame2.TextRange.Text, searchWord) Then⇒②
               Cells(counter + 7, 1) = fileName
               Cells(counter + 7, 2) = wsName
               Cells(counter + 7, 3) = gShape.TopLeftCell.Address
               Cells(counter + 7, 4) = gShape.TextFrame2.TextRange.Text
               counter = counter + 1
           End If
        End If
    Next

    childShapeLoop = counter
End Function

①でグループ化されている場合、さらにグループがあるかもしれないので自分の関数を呼び出します。

※再起関数と言います

そしてグループでなく、単一オブジェクトになるまでループを繰り返します。

図にすると下記のとおりです。

②の処理は変わらず、検索ワードに引っかかった場合に結果を表示します。

その他

グループ化も行けるようになりました（2023/7/27 追記）

上記は解除した状態のグループ画像です。

例えば「こだわりは」で検索してみましょう。

左下の吹き出しが結果として出る想定です。

想定通りに結果が出ました！

さすがに吹き出しのセルまでは細かく出ませんが、まぁよしとしましょう。

グループ化したオブジェクトはエラーが出る

~~単一の図形、もしグループ内で検索する場合はShape配下は「GroupItems」でグループを取得。~~

~~そして単一のオブジェクトに解体して文字列を取得するのが良いでしょう。~~

~~今後時間が出来たら修正します（汗~~

グループ化したオブジェクトも検索したい

~~グループ化を解除すれば検索できますので、1つ1つファイルを開いて解除しましょう（本末転倒ですがｗ）。~~

~~まず画面右上の「検索と選択」⇒「オブジェクトの選択」を確認します。~~

~~マウスカーソルアイコンが押された状態なら既にオブジェクト選択状態になっていますので何もしません。~~

~~押されていない状態なら押下し、押した状態にします。~~

~~その後、画像ではなく空いているセル上で左クリック押下⇒右クリック押下⇒グループ化⇒グループ化解除します。~~

~~すると全ての画像がグループ化解除します。~~

~~ダルいですが、単一のオブジェクトの検索前提で作られているので仕方なしです。~~

~~※検索対象ファイルは別の場所に保存して検索するのが吉ですね~~

保護ビュー、マクロエラーが出た場合

・保護ビューエラー時は、読み取り専用になっているのでファイルを右クリック⇒読み取り専用のチェックボックスを外します。

・マクロエラーが出た場合はこちらのページをご覧ください（Microsoft公式ページ）

YouTube

検索できない！⇒VBAで解決！的な流れで動画を作成しました。

参考になった、面白いと思って頂けたらチャンネル登録・高評価お願いいたします！

楽天市場でデジタル機器も見つかる♪(PR)

そろそろふるさと納税で税金対策の時期ですよ♪(PR)

まとめ

さて、オブジェクトを目視で確認するのも良いですが数が少ない、または文字数が少ない場合です。

稀にオブジェクト内に長い注記を入れることもありますが、その場合は機械的に確認することが重要です。

デジタルのことはデジタルに任せるのがベストが信条な代表はツール作りは非常に重要と思ってます。

是非ツールを使用して頂き、役に立ったと思えたなら幸いです。

最後までご覧頂き、ありがとうございました。

この記事を書いた人

中山テック代表

個人事業のシステムエンジニアです
前職はゴリゴリの営業マン(保険売りまくってた)
大抵のプログラミングはこなせます
環境構築もそれなりに出来るかと思います
趣味はゲーム、競馬、食べ歩き、旅行など
備忘と記録を残すためにブログを執筆しております

お仕事のお話は問い合わせフォームからお気軽にお声掛けください♪

月	火	水	木	金	土	日
					1	2
3	4	5	6	7	8	9
10	11	12	13	14	15	16
17	18	19	20	21	22	23
24	25	26	27	28	29	30
31