トップ > 逆引きで学ぶ ユーザーフォーム&コントロール > 追加章 現場で活かせる!実践ユーザーフォーム > B-02 AND・OR検索フォームを作る

B-02 AND・OR検索フォームを作る2022.05.20

次の書籍の第1章~5章を公開しています。
「Excel VBA 逆引きで学ぶ ユーザーフォーム&コントロール」

目次  前頁   次頁  索引

「シートをAND検索またはOR検索し、見つかったデータを新規ブックに行ごとまとめてコピーしたい」といったことはないでしょうか。

今回は、AND検索・OR検索できるフォームを作成します。
検索に該当したセルの行をまとめて新規ブックにコピーする仕様です。

【例】「藤」と「子」を含むデータを アクティブシートから検索し新規ブックに行ごとコピーする

【動画】
・フォームはモードレス表示設定です
・検索対象範囲はアクティブシート全体です
・ショートカットコマンドでもフォームが表示されるよう設定しています


このような動作の実現にはいくつかの方法が考えられますが、最も簡単だと思われる方法で実装します。

サンプルファイル ダウンロード


準備

ユーザーフォームを挿入し、次のコントロールを追加します。
■Labelコントロール
 役割:説明表示
 オブジェクト名:Label1
 個数:1


■TextBoxコントロール
 役割:キーワード入力
 オブジェクト名:TextBox1
 個数:1


■OptionButtonコントロール
 役割:AND・OR選択
 オブジェクト名:OptionButton1 / OptionButton2
 個数:2
 Caption:AND / OR
 Value:True / False ※
 ※デフォルトで「AND」が選択されている状態です


■CommandButtonコントロール
 役割:検索実行トリガー
 オブジェクト名:CommandButton1
 個数:1
 Default:True ※
 ※ [Enter]キーを押すとボタンがクリックされる設定です


サンプルコード

コードは、標準モジュールとUserForm1に記載します。

【標準モジュール】
Sub Form_Show() 'フォーム表示
    UserForm1.Show vbModeless 'モードレス表示設定
End Sub
【UserForm1】
Option Explicit

'■コマンドボタンイベント
'+++ Clickイベント +++
Private Sub CommandButton1_Click()
    'テキストボックス1の値(キーワード)を 余分な空白を削除しstrTextに代入
    Dim strText As String
    strText = WorksheetFunction.Trim(TextBox1.Value)
    
    'テキストボックスが空欄であれば終了
    If Len(strText) = 0 Then
        MsgBox "キーワードを入力してください", vbInformation
        Exit Sub
    End If
    
    'キーワードを配列化
    Dim varKeyWord As Variant 'キーワード
    If InStr(1, strText, " ", vbTextCompare) = 0 Then
        ReDim varKeyWord(0): varKeyWord(0) = strText
    Else
        varKeyWord = Split(strText, " ", , vbTextCompare)
    End If
    
    '検索開始
    Dim r As Range '検索対象格納セル
    Call Find_AND_OR(ActiveSheet, r, varKeyWord, CBool(OptionButton1.Value))

    '検索対象が見つからなければ終了
    If r Is Nothing Then
        MsgBox "検索対象が見つかりません", vbInformation
        Exit Sub
    End If

    '新規ブック(出力用)を追加追加し結果を出力
    With Workbooks.Add.Worksheets(1)
        Union(r.EntireRow, r.EntireRow).Copy '該当セルの行を適切な形に集合しコピー
        .Cells(1, "A").PasteSpecial Paste:=xlPasteValues '新規ブックに値貼り付け
        Application.CutCopyMode = False      'コピー状態を解除
        .UsedRange.Columns.AutoFit           '列幅オートフィット
    End With
    Set r = Nothing
    Unload Me
End Sub

'■オプションボタンイベント '+++ Clickイベント +++ Private Sub OptionButton1_Click() TextBox1.SetFocus 'テキストボックスにフォーカスを移す End Sub
Private Sub OptionButton2_Click() TextBox1.SetFocus End Sub
'■サブルーチン '+++ 検索 +++++++++++++++++++++++++++++++++++ '【引数】 ' Sh :検索対象シート ' r :検索結果設定セル ' varKeyWord:キーワードを格納した配列 ' f :True:AND検索 False:OR検索 '++++++++++++++++++++++++++++++++++++++++++++ Private Sub Find_AND_OR(ByRef Sh As Worksheet, _ ByRef r As Range, _ ByVal varKeyWord As Variant, _ ByVal f As Boolean) Dim i As Long 'カウンタ Dim v As Variant Dim strAddress As String 'セルアドレス格納用 Dim rngFnd As Range '検索一致セル ReDim rngUni(UBound(varKeyWord)) As Range 'セル集合用 For Each v In varKeyWord '配列varKeyWordから順に値を取得し検索 Set rngFnd = Sh.Cells.Find(What:=v, LookAt:=xlPart) '検索 If Not rngFnd Is Nothing Then strAddress = rngFnd.Address '最初に検索一致したセルのアドレスを代入 Set rngUni(i) = rngFnd Do Set rngUni(i) = Union(rngUni(i), rngFnd) 'セルを集合 Set rngFnd = Sh.Cells.FindNext(rngFnd) '次の一致セルを検索 'セルアドレスが最初に一致したセルアドレスと同じの場合は抜ける Loop Until strAddress = rngFnd.Address i = i + 1 End If Set rngFnd = Nothing Next If i = 0 Then Exit Sub Set r = rngUni(0) If f Then 'AND検索 For i = 0 To UBound(varKeyWord) Set r = Intersect(r, rngUni(i)) '共通セルを取得 Next Else 'OR検索 For i = 0 To UBound(varKeyWord) Set r = Union(r, rngUni(i)) 'セルを集合 Next End If End Sub

簡単な解説

■検索準備
コマンドボタンをクリックすると検索が始まります。

strText = WorksheetFunction.Trim(TextBox1.Value) は
ワークシート関数のTRIMを用いてスペースの処理をしています。
TRIM関数によって行われる処理は次の2つです。
・文字列の両端のスペースを削除する
・単語間に複数のスペースがある場合はスペースを1つにする

その後 If Len(strText) = 0 Then で文字数を確認し、文字数が「0」の場合はメッセージを表示し処理を終了します。
文字数が「0」でない場合は、キーワードを配列として変数varKeyWordに格納しています。

■検索
検索では、RangeオブジェクトのFindメソッドを用いて、キーワード毎に、該当するセルを集合させています。

キーワード毎のセル集合後、分岐によって、AND検索とOR検索それぞれの処理を行います。
AND検索では、キーワード毎のセル集合全てに共通するセルを取得します。
OR検索では、キーワード毎のセル集合を、全て集合させます。

■新規ブックへのデータ出力
検索に該当するセルがなければ、検索を終了し、該当するセルがあった場合は、新規にブックを挿入します。

出力にあたり、検索該当したセルの行をコピーしますが、行の重複コピーを避けるため、Unionメソッドを利用し、セル範囲を適切な形に集合させてから行をコピーしています。
Union(r.EntireRow, r.EntireRow).Copy

その後、新規ブックに値貼り付けという形で出力しています。

■オプションボタンのClickイベント
オプションボタンをクリックし、「AND」か「OR」を選択した場合、フォーカスをテキストボックスに戻す処理を入れています。

■ショートカットでマクロ実行
ショートカットでマクロを実行するには、マクロウィンドウのオプションから、ショートカットを登録します。
[Alt]+[F8]で「マクロ」ウィンドウが表示されます。
「オプション」を選択すると、「オプション」ウィンドウが表示され、[Ctrl]+[ ]の部分に任意のキーを設定します。


ここで登録したショートカットは、Windows既定のショートカットより優先されます。
例えば[Ctrl]+[c]で何らかのマクロを登録すると、そのファイルが開いている間は、[Ctrl]+[c](コピー)の使用ができなくなるため注意が必要です。


サンプルファイルのアドイン化

サンプルファイルをアドインにし有効化すると、どのブックでも検索フォームを使用できます。
アドインにする手順は次の通りです。
1.データシートを削除
2.「名前を付けて保存」→ファイル種類「Excelアドイン(*.xlam)」を選択
3.サンプルファイルを閉じてExcelを再起動
4.アドインマネージャーで該当アドインを有効化
※検索フォーム起動コマンドは[Ctrl]+[q]です
【手順動作】


書籍紹介140以上のサンプルファイル付き!

知りたいがすぐわかる! やりたいがすぐできる!
「Excel VBA 逆引きで学ぶ ユーザーフォーム&コントロール」(Kindle版)
ユーザーフォームを扱えると、VBAでできることが大きく広がります!
本書では、知りたいこと、やりたいことから、逆引きで学びを深められます。

■ 購入:amazon

ページトップへ戻る
Copyright(C) 2009- 坂江 保 All Rights Reserved.