エクセルVBAのコードで質問です。 下のコードはJ16の文字列をB3を起点とする範囲から探して、見つ

エクセルVBAのコードで質問です。
下のコードはJ16の文字列をB3を起点とする範囲から探して、見つかったセルを赤く塗りつぶすものです。
「Sub データ検索()」は本に載っていた一例です。
私は自分で書こうとした場合難しく感じたので、もっと簡単にできないかなと考えたのが下の「Sub テスト()」です。
実行すると、最後まで動作するのですが、実行されたままになっている感じで、Escを押さないといけません。
何かが違っているのだと思っていますが、分かりません。
どなたか教えて頂けないでしょうか。


Sub データ検索()
Dim Myrange As Range
Dim Hakken As Range
Dim Banti As String
Set Myrange = Range("B3").CurrentRegion
Myrange.Offset(1).Interior.ColorIndex = xlNone
Set Hakken = Myrange.Find(What:=Range("J16").Value, LookIn:=xlValues, _
LookAt:=xlPart, MatchByte:=False)
If Not Hakken Is Nothing Then
Banti = Hakken.Address
Do
Hakken.Interior.Color = vbMagenta
Set Hakken = Myrange.FindNext(Hakken)
Loop Until Hakken.Address = Banti
End If
Set Myrange = Nothing
Set Hakken = Nothing
End Sub

----------------------------------------------------------------
Sub テスト()
Dim Myrange As Range
Dim Hakken As Range
Set Myrange = Range("B3").CurrentRegion
Myrange.Offset(1).Interior.ColorIndex = xlNone
Set Hakken = Myrange.Find(What:=Range("J16").Value, LookIn:=xlValues, _
LookAt:=xlPart, MatchByte:=False)
If Not Hakken Is Nothing Then
Do
Hakken.Interior.Color = vbMagenta
Set Hakken = Myrange.FindNext(Hakken)
Loop Until Hakken Is Nothing
End If
Set Myrange = Nothing
Set Hakken = Nothing
End Sub

No.5 回答者： ミラ-_- 回答日時： 2023/04/09 22:07

「Sub テスト()」でループが終了しない原因は、見つかったセルがなくなったときにループを終了する条件が不足しているためです。

ループ条件を修正することで、問題を解決できます。

修正したコードは以下のようになります。

Sub テスト()
Dim Myrange As Range
Dim Hakken As Range
Set Myrange = Range("B3").CurrentRegion
Myrange.Offset(1).Interior.ColorIndex = xlNone
Set Hakken = Myrange.Find(What:=Range("J16").Value, LookIn:=xlValues, _
LookAt:=xlPart, MatchByte:=False)
Do While Not Hakken Is Nothing '見つかる限り続ける
Hakken.Interior.Color = vbMagenta
Set Hakken = Myrange.FindNext(Hakken)
Loop
Set Myrange = Nothing
Set Hakken = Nothing
End Sub

修正したコードでは、Doループの条件式を「Not Hakken Is Nothing」に変更しています。これにより、見つかったセルがなくなるまでループを続けます。また、ループの最後でMyrangeとHakkenを解放するようにしています。

この修正により、Sub テスト()の動作がSub データ検索()と同様になります。

No.4 回答者： fujillin 回答日時： 2023/04/07 12:30

こんにちは

＞B3を起点とする範囲から探して
ざっと見る限り、B3から検索しているとは限りませんね。
Offetをしているので、連続セル範囲の1行目はタイトル行かなんかなんでしょうかね？
ですので、検索範囲はB4セルから始まることもあれば、広い場合はA2セルからになる場合もあります。
（実際のセルの値の状態に依存することになります）

＞実行されたままになっている感じで、Escを押さないといけません。
原因は、No1様が既にご指摘の通りで、処理が終わらずそのままループを続けていることにあります。

Findメソッドは、「次の条件に合う最初のセルを返す」メソッドですので、対象が存在すれば延々と値を返し続けます。
（元に戻ってもグルグル回り続けるという意味です）
ですので、通常は「一番最初のセルを記憶しておいて、同じものが出てきたら終わりと判断する」というような処理手順を取っています。
https://learn.microsoft.com/ja-jp/office/vba/api …


方法は全然変わりますけれど・・
「条件付き書式」を利用する方法でも良ければ、セル範囲にまとめて「J16セルの値を含んでいたら色を付ける」と言うものを設定すれば、ループで検索したりしなくても良くなります。
そのような方法でも良ければ、以下のような感じで実現できると思います。

※ J16が空白の場合は、全セルがヒットしますのでご注意
（式を変えれば、「空白の場合は除く」ようにもできます）

Dim r As Range, c, ad As String
Set r = Range("B3").CurrentRegion
Set r = r.Offset(1).Resize(r.Rows.Count - 1)
ad = r(1).Address(0, 0)
Set c = r.FormatConditions
c.Add Type:=xlExpression, Formula1:="=FIND($J$16," & ad & ")"
c(c.Count).SetFirstPriority
c(1).Interior.Color = vbMagenta

この回答へのお礼

ありがとうございます。条件付き書式でもできるのですね。とても勉強になりました。

お礼日時：2023/04/07 12:49

No.3 回答者： 初心者ですが何か。 回答日時： 2023/04/07 12:25

＞と、Bantiを代入しないといけないのかがわかっていないです。

＞Hakkenには最初に見つかったセルだけの箱、と言うような意味しかないでしょうか‥‥？

代入ではなく比較をしてます。
最初に見つかったセル住所？を文字列としてBantiに格納。
セル範囲を順次検索（FindNext）していく中で、最初に登録しておいたセル住所？と同じか否かを判断させ、おなじならDo~Loopの繰り返しをやめて次のコードに実行が移るようになってます。

この回答へのお礼

ありがとうございます。わかった！ような気がします。
モヤモヤの突破口になりました。

お礼日時：2023/04/07 12:54

No.2 回答者： akudaikan55 回答日時： 2023/04/07 12:06

問題がありますね

do loop の間で、抜け出す条件の
Loop Until Hakken Is Nothing
の条件が不成立になりますのでループになります。

No.1 回答者： 初心者ですが何か。 回答日時： 2023/04/07 11:21

Set Hakken = Myrange.FindNext(Hakken)

Loop Until Hakken Is Nothing

Hakken は指定セル範囲内を全て検索したら元の位置に戻って２週目以降を実行します。
よってNothingになることはないですね。

基本としては前者が良く使われるのは２０年位前からです。
なのでそのままが良いと思いますよ。

この回答へのお礼

ありがとうございます。
まだまだ何もわかってないようです‥‥
Sub データ検索()でなぜ
Loop Until Hakken.Address = Banti
と、Bantiを代入しないといけないのかがわかっていないです。
Hakkenには最初に見つかったセルだけの箱、と言うような意味しかないでしょうか‥‥？

お礼日時：2023/04/07 12:14