【EXCEL-VBA】特定の値の入ったセルを見つけてアクティブにしたい

Question

お世話になります。

以前、こちらでユーザーフォームのボタンを押してテキストボックスに入っている値の
入ったセルを見つけてアクティブにしたするというマクロを頂きました。
※以下のコードです。教えて下さったtom04さん、ありがとうございました。
↓
https://oshiete.goo.ne.jp/qa/9297555.html
No.4／tom04さん答えです。
※この時はいろいろ答えて頂きましたので。

今までこのマクロを使っていたのですが、
最近になって、シート上に同じ値が複数あり、
最後の値のセルまで順番にアクティブにする必要が出てきました。

要するに、今までのマクロでしたらボタン(CommandButton10)を押したら
最初のセルがアクティブになり
再度ボタン(CommandButton10)を押しても何もしません。


ですがシート上に同じ値が複数あった場合、
ボタン(CommandButton10)を1回押したら1個目のセルがアクティブ、
もう1回押すと2個目のセルがアクティブ、
次は3個目のセルがアクティブ、、、最後まで、、。
と特定の値の入ったセルを上から順番にアクティブにするようにしたいと思っています。

自力でカスタマイズしようと思ったのですが、
今の私の実力では無理でした。

すいませんが詳しい方、説明の上手な方、直接、コードで説明できる方、
お手数ですが教えて下さい。よろしくお願いします

以下はリンク先のもので教えて頂いたコードです。
このコードをカスタマイズしてもいいですし、書きにくいようでしたら
新規のコードでも構いません。

機能さえ満たしていれば問題ないです。
お手数ですがよろしくお願いします。

ーーーーーーーーーーーーーーーーーーー
Private Sub CommandButton10_Click()

 Dim str As String, c As Range
 If TextBox1 <> "" Then
 str = TextBox1
 Set c = ActiveSheet.Cells.Find(what:=str, LookIn:=xlValues, lookat:=xlWhole)

 If Not c Is Nothing Then
 c.Select
 Else
 MsgBox "該当データなし"
End If
 Else
 MsgBox "入力してください"
End If

End Sub

ママチャリ · Accepted Answer

FindメソッドにAfterオプションを設定すれば、お望みの動きになると思います。
次の行を書き換えてみて下さい。

Set c = ActiveSheet.Cells.Find(what:=str, LookIn:=xlValues, lookat:=xlWhole)
　↓
Set c = ActiveSheet.Cells.Find(what:=str, after:=ActiveCell, LookIn:=xlValues, lookat:=xlWhole)

WindFaller · Answer

●>前述のとおり、メッセージボックス、OK、終了、、、。

もしかしたら、正しくコードが貼り付けていない可能性がありますね。

'下の2行(←*)は、モジュールの一番上に貼り付けます。いわゆる「プロシージャ外変数」とも言われています。それが正しく入れていないと、その後、コマンドボタンを押しても、myRngs の中身は起動ごとに空になってしまいます。プロシージャ内では、Static ステートメントがありますが、前者のほうが使いやすいです。その格納状況は、ローカルウィンドウでも、Me（ミー) という中の変数の名前をクリックすれば確認できます。

Dim sText As String　　 'モジュール変数　（画面の一番上)　　←*
Dim myRngs As Collection　'モジュール変数（画面の一番上)　←*
Private Sub CommandButton1_Click()

>メッセージボックス「検索物は、3見つかりました。」
>「OK」
CommandButton10_Click  '<-#3のコードでは、1でしたが。

WindFaller · Answer

#3の回答者です。

>3)カーソル(アクティブセル)は全く動きません　(複数選択もしない)

読み返してみて、私は、詳しい使い方をまったく説明していませんでしたね。

私は、人が回答した後にレスをつけるなら、違うコンセプトのものを提供しようと考えました。前の人と同じスタイルのものを出すのは失礼ですからね。マクロの本来の定義は、何か一つの仕事をするパッケージの意味ですから、仕事をしていません。また、本来、マクロというのは、一回の仕事を終えたら、次はまた同じような仕事を新たにするという仕組みのはずです。しかし、このマクロは、次の別の仕事を用意しているというわけです。

一回のクリックで何件か出てきたら、その後は動きません。
しかし、もう一度、押してみてください。さらにもう一度押してみてくれれば、1個ずつ進んでいきます。

つまり、「myRngs」というコレクションオブジェクトに、見つけたセルを、格納してあります。そして、クリックするごとに、その選んだセルの場所に行き、MyRngs の中のセルのオブジェクトの登録を消していく、ということをしています。最後、空になって使い切ると「終了しました」と出てきます。（配列でも可能ですが、減らしていく方法が、コレクションオブジェクトのほうが簡単なのです。)

このメリットは、セルがどこにあろうとも、一回探したものは、「myRngs」の格納したセルをクリックして消費しないと、次の順番にあるセルに飛んでいかない、という仕組みになっています。ただし、途中で辞めたくなったら、リセットとして、ボタン上で右クリックすれば、解除されます。

このやり方や考え方が分かれば、マクロとして、いろんなことに応用できるとは思いませんか？

WindFaller · Answer

こんにちは。

また、GooUserラックさんの話に便乗させていただきますが、（いつもすみません)　ただ、誰かの発案がないと、私は頭に浮かびません。

>該当するセルを全て選択状態にするのはいかがでしょうか？

私もちょっと思ったのですが、それを、コレクションオブジェクトに入れてしまうという方法はどうか、ということを考えました。以下に作ってみましたが、色を付けるタイミングが違うかもしれませんね。終了の段で色を付けるけれども、こちらは、次に移る時に、どれのセルかで色が付くようになっています。これは、順番を重視したマクロを作ったからです。色さえ付けなければ、ただ、順番どおりに動いていきます。ちょっと複雑になってしまいましたね。参考にもならないでしょうけれども、Collection の使い方のテクというところでしょうか。

*
LookIn:=　検索値の種類 xlFormulas（数式)　/ xlValues（値)/ xlComments （コメント)
LookAt:=　検索値、一部分　xlPart/検索値全部とピッタリ合うこと。xlWhole　
ただし、xlWhole に、ワイルドカードが入りますから、場合によっては、xlWhole のほうが良い時もあります。

After:=指定したセルの次から検索　（私自身は、これはうまく行ったことは少ないです。)

'//
Dim sText As String　　 'モジュール変数
Dim myRngs As Collection　'モジュール変数
Private Sub CommandButton1_Click()
Dim c As Range
Dim FirstAddress As String
Static i As Long
On Error Resume Next
n = 0
n = myRngs.Count
On Error GoTo 0
If n > 0 Then
　 myRngs(1).Select
　 myRngs(1).Interior.ColorIndex = 41　'パステルの青色
　 myRngs.Remove 1
　 If myRngs.Count = 0 Then MsgBox "終了しました。", vbInformation
　Exit Sub
Else
　Set myRngs = New Collection
End If
sText = InputBox("Enter the Word")
If sText = "" Or StrPtr(sText) = 0 Then Exit Sub
With ActiveSheet.Cells
Set c = .Find( _
　What:=sText, _
　LookIn:=xlValues, _
　LookAt:=xlPart, _
　SearchDirection:=xlNext, _
　SearchOrder:=xlByColumns)
　　 If Not c Is Nothing Then
　　　FirstAddress = c.Address
　　　　Do
　　　　myRngs.Add c
　　　　a = c.Address
　　　　Set c = .FindNext(c)
　　　　If c.Address = FirstAddress Then Exit Do
　　　Loop Until c Is Nothing
　　 Else
　　　 MsgBox "'" & sText & "' は見つかりません。", vbExclamation
　　 End If
End With
If myRngs.Count > 0 Then MsgBox "検索物は、" & myRngs.Count & "見つかりました。", vbInformation
End Sub

'検索のメモリのリセットボタン
Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim n As Long
On Error Resume Next
　n = 0
　n = myRngs.Count
On Error GoTo 0
　If n > 0 Then
　　If MsgBox("リセットしますが、よろしいですか？", vbOKCancel) = vbCancel Then Exit Sub
　End If
If Button = 2 Then
　Set myRngs = New Collection
End If
End Sub

GooUserラック · Answer

後での使いやすさのため、該当するセルを全て選択状態にするのはいかがでしょうか？
イメージが沸き難ければ [Ctrl] キーを押しながらマウスをクリックして複数のセルを選択した状態です。その状態だと [Enter] キーを押すごとに次のセルに移るので便利です。もちろんセルの内容を書き換えて次に移ることもできます。お試しいただいてご意見いただけると助かります。

【EXCEL-VBA】特定の値の入ったセルを見つけてアクティブにしたい

FindメソッドにAfterオプションを設定すれば、お望みの動きになると思います。

●>前述のとおり、メッセージボックス、OK、終了、、、。

#3の回答者です。

こんにちは。

後での使いやすさのため、該当するセルを全て選択状態にするのはいかがでしょうか？

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング