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

VBA100本ノック 95本目を動画で解説しています。Excelの神髄さんの模範解答はコチラ

---

【VBA】図形のテキストを検索するユーザーフォームの作成～VBA100本ノック_95～

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

www.youtube.com

問題

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

解答

Private Sub btnSearch_Click()
    Dim wb As Workbook: Set wb = ActiveWorkbook
    Dim ws As Worksheet
    Dim sp As Shape
    Dim ary() As Variant
    Dim i As Long
    For Each ws In wb.Worksheets
        For Each sp In ws.Shapes
            If sp.TextFrame2.HasText Then 'もし図形にテキストが入っていた場合のみ処理
                If sp.TextFrame2.TextRange.Text Like "*" & Me.txtSearch.Text & "*" Then
                    i = i + 1
                    If i = 1 Then ReDim ary(1 To 4, 1 To i)
                    ReDim Preserve ary(1 To 4, 1 To i)
                    ary(1, i) = ws.Name & "!" & sp.TopLeftCell.Address
                    ary(2, i) = sp.TextFrame2.TextRange.Text
                    ary(3, i) = ws.Name
                    ary(4, i) = sp.Name
                    '配列にぶち込む
                End If
            End If
        Next
        If i = 0 Then
            MsgBox "該当する図形がありません"
            Exit Sub
        End If
    Next
    Me.lstSearch.ColumnCount = 2
    Me.lstSearch.List = Transpose(ary)
End Sub
Private Function Transpose(ByRef aAry) As Variant
    Dim ary, i As Long, j As Long
    ReDim ary(LBound(aAry, 2) To UBound(aAry, 2), LBound(aAry, 1) To UBound(aAry, 1))
    For i = LBound(aAry, 1) To UBound(aAry, 1)
        For j = LBound(aAry, 2) To UBound(aAry, 2)
            ary(j, i) = aAry(i, j)
        Next
    Next
    Transpose = ary
End Function
Private Sub lstSearch_Click()
    Dim ws As Worksheet
    With Me.lstSearch
        Set ws = Sheets(.List(.ListIndex, 2)) 'aryにぶち込んだ3つ目のインデックスの値
        ws.Select
        ws.Shapes(.List(.ListIndex, 3)).Select 'aryにぶち込んだ4つ目のインデックスの値
    End With
End Sub

■考え方・流れ
0:00 冒頭・問題確認
2:16 ユーザーフォームの復習
4:13 全シート、全図形に対して処理
6:18 取得したテキストをリストボックスへ出力
9:07 リストボックスを選んだら該当する図形をセレクト
11:45 該当する図形が1(0)つだった場合の分岐
11:44 セル結合がされていた場合の分岐

ユーザーフォームはむかーしやったね！！！もう懐かしいわ…

そして！！何かしら文字が入っていた場合、かつ！！検索的のテキスト(Me.txtSearch.Text)が含まれていた場合に
処理をしたいから…こんな感じだね！！

ここはちょっと難しいんだけど…
見つかったテキストが1つだけだった場合と2つ以上の場合に分岐を入れてあげることと、
WorksheetFunctionのTranseposeで、2次元配列の行列を入れ替えてあげるってことがポイント！！

めんどくせえ～！リストボックス…

リストボックスを選んだら該当する図形をセレクト

これまででやっと、リストボックスにデータを出力できた！
お次はリストボックスをクリックしたら、該当図形を選択したい！！
つまり、リストボックスをクリックしたときのイベントマクロを作ってあげないといけない！

ほんで、その前に準備として、
リストボックスに表示する文字は、アドレスとテキストの2列だけの表示で良かったんだけど、
こちら側で使う用の3,4列目を追加してあげましょう！！

そして作ったシート名と図形名を使って！！
該当する図形をセレクトするコードを書いていくって感じ！！！

ユーザーがわからは見えない情報を作って、使ってるところがなんとも
エンジニアっぽくていいですね～！？？？

あ、、ちなみに、リストボックスの2ってのは、配列の2番目、つまり0始まりだから…
3つ目の列、つまりシートをセレクトしてるって感じ…
説明むずすぎい！！！

該当する図形が1(0)つだった場合の分岐

よし！最後に！！
該当する文字を含む図形がなかった！！もしくは1つしかなかった場合！の分岐！！
え？そんなん必要なん？？聞いてへんわー

って言うのも…WorksheetFunctionのTransepose関数を使って、
2次元配列を行列入れ替えてたから…。
この関数って、列が1つしかない配列に対して使うと、1次元配列を返しちゃうらしい！
そうなんか～！！
まあ、言われてみればそうかwww

つまり…自分で作ったほうが速いってこっちゃ！！
2次元配列を回転 とかでググったら、いくらでもコードは出てくるから、それに変更しとこう！

やってることはノック34本目とおんなじだね！！

あとごめん！最後に、もし図形がなかった場合の分岐もループのあとに入れて終了！！ww

難しかったけど…これまでの知識を総動員すれば何とかなるはず！の問題！

あとがたり

おはこんばんちは。uぷ主です。
95本目！！ユーザーフォームの問題でした！

ぐああああ！！！ここできたか！！！
むずいんだよなーユーザーフォーム…

諦めよっかな？と心の声が…

でも頑張った！！

これがノック50本目までにきてたら、ノック諦めてましたね。たぶん。
あとちょっとだからこそ…きついのを持ってくる…
鬼畜…。鬼畜っすわ…。と一人で呟きながらやってました。

もうノック後半からは、1本の動画にまとめるって決めてるんで
だいぶ、これまでにやった内容のところとかは割愛しました。

分かりにくかったら…過去の動画を見直してくれ…許せ…

と、いうわけで！！
2022年最後の動画になりましたね！！
投稿予約は12月31日！！

みんな！紅白なんかよりノック動画見ろよ！！
視聴回数めちゃくちゃ落ちてきてるぞ！！

勉強しろよ！

それじゃ良いお年を～！！