95本目：図形のテキストを検索するフォーム作成

Excel&VBA解説サイト「エクセルの神髄」様出題の問題集、
「VBA100本ノック」に対する私の回答と解説のページです。

100本ノックの出題リストはこちらから
excel-ubara.com

出題：図形のテキストを検索するフォーム作成

Activeブックの全シート・全図形のテキストから指定の文字列を探すフォームを作成。
「検索」で「検索文字列」を含む図形をリスト表示。
シート名!左上セル番地;テキスト文字列 ←列幅は随意
表示されたリストをクリック選択したら当該図形を選択してください。

◇ 出題ページはこちら

ソースコード

サンプルファイルはこちら
【和風スパ】VBA100本ノック#095(図形のテキストを検索するフォーム作成).xlsm

UF_ユーザーフォーム表示

Option Explicit

' 実行プロシージャ
Sub ★図形テキスト検索起動()
    Call UF図形テキスト検索.Show(vbModeless)
End Sub

UF図形テキスト検索

Option Explicit

' Dic内の配列レイアウト
Enum CNoLBox図形リスト
    設置場所 = 0
    図形テキスト
    図形オブジェクト
End Enum

' ListBox用Dictionary
' Key：ListBoxIndex　Item：「図形位置,図形テキスト,オブジェクト本体」の一次元配列
Private Dic図形リスト As Dictionary

' 対象ブックと検索ワード
Private wb対象ブック As Workbook
Private key検索文字列 As String

' 検索ボタン実行
Private Sub btn検索ボタン_Click()

    key検索文字列 = TextBox検索文字列.Text
    If key検索文字列 = "" Then Exit Sub
    
    ' ■ 検索結果をDictionaryに格納
    Call 対象図形を検索してDictionaryに格納する
    
    If Dic図形リスト.Count = 0 Then
        ListBox図形リスト.Clear
    End If
    
    ' ListBoxにDictionaryを反映
    ListBox図形リスト.List = GetArr二次元配列←ジャグ配列(Dic図形リスト.Items)

End Sub

' 検索結果をDictionaryに格納
Private Sub 対象図形を検索してDictionaryに格納する()
    
    Dic図形リスト.RemoveAll
    
    Dim wb対象ブック As Workbook
    Set wb対象ブック = ActiveWorkbook
    
    ' 全シート・全図形をループ
    Dim ws As Worksheet
    For Each ws In wb対象ブック.Worksheets
        
        Dim shp As Shape
        For Each shp In ws.Shapes
        
            ' テキストがあり、かつ検索文字列を含むか判定
            If shp.TextFrame2.HasText Then
                If InStr(shp.TextFrame2.TextRange.Text, key検索文字列) > 0 Then
            
                    ' 図形位置,図形テキスト,オブジェクト本体 を一次元配列に
                    Dim Arr各図形情報(0 To 2): Erase Arr各図形情報
                    Arr各図形情報(CNoLBox図形リスト.設置場所) _
                        = ws.Name & "!" & shp.TopLeftCell.Address(False, False)
                    Arr各図形情報(CNoLBox図形リスト.図形テキスト) _
                        = 文中改行を指定文字に置き換える(shp.TextFrame2.TextRange.Text, "<br>")
                    Set Arr各図形情報(CNoLBox図形リスト.図形オブジェクト) = shp
            
                    ' Dictionaryに格納（Key：ListBoxIndex　Item：一次元配列）
                    Dic図形リスト.Add Dic図形リスト.Count, Arr各図形情報
                
                End If
            End If
        
        Next
        
    Next
    
End Sub

' 図形リスト(ListBox)の選択
Private Sub ListBox図形リスト_Click()

    Dim R_選択行 As Long
    R_選択行 = ListBox図形リスト.ListIndex

    Dim 対象図形 As Shape
    Set 対象図形 = Dic図形リスト.Item(R_選択行)(CNoLBox図形リスト.図形オブジェクト)
    
    ' 対象の図形を選択
    対象図形.Parent.Activate
    対象図形.Select

End Sub

' コンストラクタ
Private Sub UserForm_Initialize()
    
    ListBox図形リスト.ColumnCount = 2
    ListBox図形リスト.ColumnWidths = "100,1000"
    
    Set Dic図形リスト = New Dictionary
    
End Sub

Ut_汎用関数

Option Explicit

' 改行文字の置き換え
Function 文中改行を指定文字に置き換える(元テキスト As String, Optional 置換テキスト As String = " ") As String

    Dim 結果テキスト As String
    結果テキスト = Replace(元テキスト, vbCrLf, 置換テキスト)
    結果テキスト = Replace(結果テキスト, vbCr, 置換テキスト)
    結果テキスト = Replace(結果テキスト, vbLf, 置換テキスト)

    文中改行を指定文字に置き換える = 結果テキスト

End Function

' 配列の要素数の取得
Function Count配列の要素数(Arr, Optional 次元 = 1) As Long
    Count配列の要素数 = UBound(Arr, 次元) - LBound(Arr, 次元) + 1
End Function

' 二次元配列←ジャグ配列
Function GetArr二次元配列←ジャグ配列(Arrジャグ配列 As Variant) As Variant
    
    Dim i As Long, j As Long ' ジャグ配列のインデックス
    Dim R As Long, C As Long ' 二次元配列のインデックス

    Dim Arr出力配列()

    Dim 最大要素数 As Long: 最大要素数 = 0

    ' 配列内の配列の中で最も大きい要素数を取得
    For i = LBound(Arrジャグ配列) To UBound(Arrジャグ配列)
        
        Dim 現要素数 As Long: 現要素数 = Count配列の要素数(Arrジャグ配列(i))
        If 現要素数 >= 最大要素数 Then 最大要素数 = 現要素数

    Next
    
    ' 出力二次元配列を準備
    ReDim Arr出力配列(1 To Count配列の要素数(Arrジャグ配列), 1 To 最大要素数)
    
    ' 全要素を代入
    R = 1
    For i = LBound(Arrジャグ配列) To UBound(Arrジャグ配列)
        C = 1
        For j = LBound(Arrジャグ配列(i)) To UBound(Arrジャグ配列(i))
            
            If IsObject(Arrジャグ配列(i)(j)) Then
                Set Arr出力配列(R, C) = Arrジャグ配列(i)(j)
            Else
                Let Arr出力配列(R, C) = Arrジャグ配列(i)(j)
            End If
            
            C = C + 1
        Next
        R = R + 1
    Next
    
    GetArr二次元配列←ジャグ配列 = Arr出力配列

End Function

解説

今回はユーザーフォームに関する問題でした。

私は普段ユーザーフォームをほとんど使っていないので、
ソースコードよりフォームの設計にかなり手間取りました笑

今回のマクロは図形のリストをListBoxに表示する必要がありますが、
これをDictionaryで実装しています。

ListBoxに記録していき、その図形を選択しようにも、

• 指定された仕様が図形名称を表示しないリスト
• そもそも図形は名前の重複を許すためNameプロパティではオブジェクトを特定できない

という問題があって記録された図形を選択できません。

これを解決するために、

• まずは検索結果をDictionaryに入れる
• KeyはListBoxのIndex
• Itemは「図形の位置,記載テキスト,オブジェクト本体」の一次元配列
• フォームのリストを選択した際はDictionaryから呼び出して選択

という方法をとっています。

Variant型の配列はSetを使えばオブジェクトそのものを格納できるため、
これならシェイプの特定問題（同名図形が存在できる）も関係ないですね。

今回DictionaryのItemには「String,String,Shape」の配列が入っていますが、
ListBoxに配列ごと代入する際ははみ出た部分は無視される便利な仕様があります。

よって、List側のColumnsを「1（0はじまりなので要素数は2）」としておけば、
第3要素にShapeオブジェクトが入っていても無視してフォームに表示してくれます。

それにしても、Itemが配列のDictionaryはItemsがジャグ配列(配列の配列)で、
セルやこういったListに出力するには二次元配列を使用するため、
ジャグ配列⇒二次元配列の汎用関数は本当に便利ですね。

このノックを解いていてもかなりの頻度で使用しています。

これを用意しておけばDictionaryに配列を入れた時の出力コードが簡単になり、
Redim Preserveみたいなクソコードに頼る必要がなくなります。

是非とも活用して、Array In Dictionary を便利に使い倒してください。
www.limecode.jp