Excel,VBA 連続検索のコードを作成したい

Question

いつもお世話になっております。
Excel、VBAの検索コードの作成で躓いております。

【やりたいこと】
「Textbox1に入力した商品名をシート1のD列と照合し同じ値があれば該当セルまで移動&Textbox2に表示。」
ここまでは作成できました。
最終的にD列には同じ商品名が複数存在するのでコマンドボタンをクリックする度に検索を続けて行えるようにしたいです。(Textbox2も連動する)

コードについてご教授頂けたらと思います。
宜しくお願い致します。

【オブジェクト】
Textbox1＝商品名を入力する
Textbox2＝Textbox1に入力された商品名を表示する
CommandButton1＝クリックする度にTextbox1に入力された商品名をシートのB列と照合する

【コード】
Private Sub 検索_Click()

Static rngSearch As Range
Static word As String

Dim F As Variant
Dim myRange As Range

If TextBox1 = "" Then

    MsgBox "「商品名」を入力してください。"

Else

　　　
Set myRange = ActiveSheet.Range("D:D")　'D列から値を検索

    If word <> TextBox1 Then
        Set rngSearch = myRange.Find(What:=TextBox1, LookAt:=xlPart)
        word = TextBox1
    Else
        Set rngSearch = myRange.FindNext(rngSearch)
    End If

    If Not rngSearch Is Nothing Then
        
        rngSearch.Select　'ヒットした箇所を選択する

        TextBox2 = rngSearch.Offset　'選択しているセルをTextBox2に表示する
    Else

        MsgBox "見つかりませんでした。"
      
    End If
   
End If

End Sub

TextBox1

Answer 1

Option Explicit

Dim mrngFind As Range
Dim mrngAfter As Range
Dim mFlg As Boolean

Private Sub CommandButton1_Click()
    Dim sKey As String
    Dim c As Range
    Dim sProm As String
    
    s = Me.TextBox1.Text
    If Len(s) = 0 Then WayOut
    
    Set c = mrngFind.Find(s, mrngAfter, , xlPart)
    
    If c Is Nothing Then WayOut
    
    Me.Label1.Caption = c.Value
    Me.CommandButton1.Caption = "次へ"
    Set mrngAfter = c
    Exit Sub

WayOut:
    If Len(s) > 0 Then
        sProm = s & "が見つかりませんでした"
    Else
        sProm = "検索文字入力欄が空欄です。"
    End If
    
    msgbox sProm
    Setオブジェクト初期化
End Sub

Private Sub TextBox1_AfterUpdate()
    mFlg = True
    Setオブジェクト初期化
End Sub

Private Sub UserForm_Initialize()
    With Me.Label1
        .BackColor = vbWhite
        .SpecialEffect = fmSpecialEffectSunken
    End With
    
    Setオブジェクト初期化
End Sub

Private Sub Setオブジェクト初期化()
    Set mrngFind = ThisWorkbook.Worksheets(1).Range("D:D")
    Set mrngAfter = mrngFind(mrngFind.Count)
    If mFlg = False Then Me.TextBox1.Text = ""
    Me.Label1.Caption = ""
    Me.CommandButton1.Caption = "検索"
    mFlg = False
End Sub

やりたいことはこんな感じですかね？
結果の表示は選択や編集はさせたくないのでラベルにしてます。
見た目はテキストボックスと同じに出来ます。

Userform上に
Textbox1
Label1
CommandButton1
があるものとして書いてます。

時間が無くて動作確認はしてないので、バグが多数あるかも知れませんが、
どんな時に何をするというのを考えて、
同じ作業は、別途プロシージャを分けて再利用できるようにします。
各プロシージャでまたがって内容を保持しておいたり、変更したい場合は
(同じプロシージャを再度実行する時も）、
モジュールレベルで変数を宣言します。

参考になれば。。。

シート上用に改変しました。

Option Explicit

Dim mrngFind As Range
Dim mrngAfter As Range

Private Sub CommandButton1_Click()
    Dim c As Range
    Dim sKeyWord As String

    sKeyWord = Me.TextBox1.Text
    If mrngFind Is Nothing Then Setオブジェクト初期化
    Set c = mrngFind.Find(sKeyWord, mrngAfter, , xlPart)
    If c Is Nothing Then GoTo WayOut
    With c
        Application.Goto .Cells
        Me.Label1.Caption = .Value
    End With
    Me.CommandButton1.Caption = "次へ"

    Set mrngAfter = c
    Exit Sub

WayOut:
    MsgBox sKeyWord & "は見つかりませんでした。", vbExclamation
    Setオブジェクト初期化
End Sub

Private Sub TextBox1_Change()
    Me.CommandButton1.Enabled = Len(Me.TextBox1.Text)
    Me.Label1.Caption = ""
End Sub

Private Sub TextBox1_LostFocus()
    mFlg = False
End Sub

Private Sub Setオブジェクト初期化(Optional ByVal flg As Boolean = True)
    If flg Then Me.TextBox1.Text = ""

    Set mrngFind = Me.Range("D:D")
    Set mrngAfter = mrngFind(mrngFind.Count)
    Me.CommandButton1.Caption = "検索"
    mFlg = False
End Sub

動作確認してたら、わけわかんなくなったので、
期待通りの動きになってないかも＾＾；
参考になれば。。。（ならないかも＾＾；）

※注
検索ボタンは何も入力されてない時はメッセージを出すのではなく、
そもそもボタンを押せないようにするといいです。
やたらとメッセージを出されると、使う側はうるさいし、
クリックをいちいち余分にしないといけなくなるので。
プロパティウィンドウで、
Enabledプロパティの初期値をFalseにしておきます。
Labelコントロールは、
コントロールの選択から探してください。

Comments

[mattuwan]

うお、シート上の話でしたか＾＾；；

[abc-.-cba]

mattuwan様

ご回答ありがとうございます。
同じ作業はプロシージャを分ければ再利用できるのですね。勉強になります。
Userformで使用する際はぜひ参考にさせて頂きます。

[mattuwan]

Userformでなくても、使える場面では使ってください。

[abc-.-cba]

mattuwan様

これから色々な機能を付けていこうと思っておりますので使える場面では参考にさせて頂きます。
質問させて頂いた内容は完成しました。ご回答ありがとうございました。

Answer 2

最終的にD列には同じ商品名が複数存在するのでコマンドボタンをクリックする度に検索を続けて行えるようにしたいです。

まずはFindNextメソッドについて理解してから、コードを見直してください。

【エクセルVBA】FindNextメソッドで指定範囲内の検索条件にヒットする値をすべて取得する方法

あと、どのような動作にしたいのか、具体的な仕様を明確にしましょう。

このコードはユーザーフォーム上のコードでしょうか。
ユーザーフォームは、モードレスなのか、モーダルなのか、どちらでしょうか。

最初に検索ボタンをクリックしたら最初に一致したセルへ移動して、
続けてクリックしたら次に一致するセルへ移動するということでしょうか。
最後まで検索したら、どうするのでしょうか。

Textbox1 と Textbox2 に同じ値を表示する意味があるのでしょうか。

Comments

[abc-.-cba]

hatena19様

ご意見ありがとうございます。

あと、どのような動作にしたいのか、具体的な仕様を明確にしましょう。
＞失礼しました。動作としては
　TextBox1の値をシートD列から検索→最初にヒットしたセルを選択→
　検索する度にヒットするセルを上から選択→最後まで検索し終わったら「"検索終了"」
　のメッセージ表示→TextBox1の値をクリアする。
　TextBox2には現在選択されているセルの値を表示させる。
　の流れを想定しています。

このコードはユーザーフォーム上のコードでしょうか。
ユーザーフォームは、モードレスなのか、モーダルなのか、どちらでしょうか。
>ユーザーフォームは使用しておりません。
　シート状にActiveXコントロールを使用して作成しております。

最初に検索ボタンをクリックしたら最初に一致したセルへ移動して、
続けてクリックしたら次に一致するセルへ移動するということでしょうか。
最後まで検索したら、どうするのでしょうか。
＞はい。その通りです。最後まで検索したらの処理を考えておりませんでした。
　「"検索終了"」等のメッセージを表示させたいです。

Textbox1 と Textbox2 に同じ値を表示する意味があるのでしょうか。
＞Textbox2に表示された商品名の担当者にOutlookにてメールを作成する仕組みを
　別で作成していますのでそちらに使用する予定です。

[hatena19]

検索した後、検索結果をどのように利用するかによって、最適なUIも変わってきます。
それを吟味する必要があるように感じます。

例えば、
> 検索する度にヒットするセルを上から選択
> TextBox2には現在選択されているセルの値を表示させる。
とのことですが、これは、TextBox1 の値と同じになりますよね。
ということは検索終了までまったく変化することはないです。
これは必要ですか？

検索結果をどのように利用するかにもよりますが、
１回ボタンをクリックしたら、TextBox1の値をすべて選択した状態にする。
というUIも考えられます。
これなら、何度もボタンをクリックする必要はなく、かつ、どのセルが一致しているかも一目瞭然です。

[hatena19]

LookAt:=xlPart を見落としてました。部分一致での検索なのでTextBox2の存在意義はありますね。

[abc-.-cba]

hatena19様

ご回答ありがとうございます。

最終的に以下の2つの検索結果を考えております。
１．TextBox1の値をシートから検索後にTextBox２に表示されている商品の担当者にメール作成
２．TextBox1の値をシートから検索するだけ。検索終了後は「"検索終了"」等のメッセージを表示

１については完成しました。
現在は２について作成しているところです。

Answer 3

まったく動作確認していませんが、こんな感じでどうでしょうか。
TextBox1とFindの結果を静的変数に保持しています（グローバル変数でも可）

Private Sub 検索_Click()
    
    Static rngSearch As Range
    Static word As String
    
    '変数の宣言
    Dim F As Variant
    Dim myRange As Range
            
    'Textbox1に値が入ってなければ
    If Text_Server_Input = "" Then
        '"「商品名」を入力してください。"と表示
        MsgBox "「商品名」を入力してください。"
    Else

        Set myRange = ActiveSheet.Range("D:D")

        If word <> TextBox1 Then
            Set rngSearch = myRange.Find(What:=TextBox1, LookAt:=xlPart)
            word = TextBox1
        Else
            Set rngSearch = myRange.FindNext(rngSearch)
        End If

        'Textbox1の値がシート上にあれば
        If Not rngSearch Is Nothing Then
            'ヒットした箇所を選択する
            rngSearch.Select
            'Textbox2にTextbox1の値を表示する
            Textbox2 = TextBox1

        Else

            'ヒットしなければ"見つかりませんでした。"と表示
            MsgBox "見つかりませんでした。"

            'IFステートメント終了
        End If
        'IFステートメント終了
    End If
    'Textbox1の内容をクリアする
    TextBox1 = Clear
    Textbox2 = Clear

End Sub

Comments

[abc-.-cba]

早急なご回答ありがとうございます。
早速訂正頂いたコードを試しました。

結果、下記処理で躓きました。

'Textbox1の内容をクリアする
TextBox1 = Clear
Textbox2 = Clear

検索ボタンをクリックするとテキストボックスの値がクリアされるので連続検索が不可能でした。
試しに上記のコードを抜くと連続検索出来ました。
この場合、テキストボックスの値をクリアする方法はありませんでしょうか？

[ttyp03]

If word <> TextBox1 Then
これを
If Trim(TextBox1.Text) <> "" Then
これでいけるかな？
word変数の定義、処理は消してください。

余談ですが「Clear」って空文字か何かでしょうか？

[abc-.-cba]

ttyp03様

ご回答ありがとうございます。
教えて頂きましたコードに変更しましたが、
文字検索→テキストボックスの値がクリア→"商品名を入力してください"
の処理順番になり連続検索できませんでした。
現在のコードを質問に記載させて頂きました。

clearは元々TextBox1 = Clearでテキストボックスの値そのものをクリアしていました。
次回検索時に便利なのでテキストボックスの値を空にしたいと思っております。

[abc-.-cba]

よくよく考えると連続検索中にクリアは不可能ですかね？
であれば別でクリアを実行するコマンドボタンを作成しようと思います。

[ttyp03]

> よくよく考えると連続検索中にクリアは不可能ですかね？

あまり良いUIではないですよね。
消さない方向で調整した方が変な実装をしなくて済むと思います。

> clearは元々TextBox1 = Clearでテキストボックスの値そのものをクリアしていました。

いや、Clearって変数ですよね？空文字が入っているんですか？って質問です。

[abc-.-cba]

ttyp03様

ご回答ありがとうございます。
clearについては別で作成することにしました。

認識が違っていました。すみません。はい。空文字が入っています。

[ttyp03]

では最初に回答した方法でできそうですね。
というかできてましたね。

[abc-.-cba]

ttyp03

はい、コードのご提示を頂き完成しました。
本当にありがとうございました。
これから色々な機能を付けていこうと思っています。
VBAの学習に励みます。
この度は、ありがとうございました。