エクセル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
A 回答 (5件)
- 最新から表示
- 回答順に表示
No.5
- 回答日時:
「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
- 回答日時:
こんにちは
>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
No.3
- 回答日時:
>と、Bantiを代入しないといけないのかがわかっていないです。
>Hakkenには最初に見つかったセルだけの箱、と言うような意味しかないでしょうか‥‥?
代入ではなく比較をしてます。
最初に見つかったセル住所?を文字列としてBantiに格納。
セル範囲を順次検索(FindNext)していく中で、最初に登録しておいたセル住所?と同じか否かを判断させ、おなじならDo~Loopの繰り返しをやめて次のコードに実行が移るようになってます。
No.2
- 回答日時:
問題がありますね
do loop の間で、抜け出す条件の
Loop Until Hakken Is Nothing
の条件が不成立になりますのでループになります。
No.1
- 回答日時:
Set Hakken = Myrange.FindNext(Hakken)
Loop Until Hakken Is Nothing
Hakken は指定セル範囲内を全て検索したら元の位置に戻って2週目以降を実行します。
よってNothingになることはないですね。
基本としては前者が良く使われるのは20年位前からです。
なのでそのままが良いと思いますよ。
ありがとうございます。
まだまだ何もわかってないようです‥‥
Sub データ検索()でなぜ
Loop Until Hakken.Address = Banti
と、Bantiを代入しないといけないのかがわかっていないです。
Hakkenには最初に見つかったセルだけの箱、と言うような意味しかないでしょうか‥‥?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) オブジェクトが見つかりません 1 2023/06/24 19:43
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Excel(エクセル) 指定文字列が該当するA列をアクティブセルにするには 3 2022/08/17 13:18
- Excel(エクセル) EXCEL マクロで行を挿入して貼り付けようとするとエラーになる。 2 2022/05/24 09:43
- Visual Basic(VBA) VBAが止まります。 3 2022/08/31 14:09
- Excel(エクセル) 日付で矢印マクロ 4 2023/07/25 16:47
- Visual Basic(VBA) Excel vbaについての質問 3 2023/04/18 16:14
- Visual Basic(VBA) VBAでoutlook365が起動しません。 4 2022/08/25 13:31
- Visual Basic(VBA) ワークブック内すべて検索 2 2022/12/20 20:13
- Visual Basic(VBA) シフト表のコマで「ブロック」されている前の時間の「出」を同一列の「休」と入れ替えたいがふぇきません。 2 2023/08/02 18:49
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルVBA 作業後に選択範囲...
-
最小化ボタンで最小化したフォ...
-
Excel vba 条件分岐 空白セルが...
-
GetAsyncKeyState() を利用する...
-
Switchのわんことあそぼ、めざ...
-
自動入力ツール「UWSC」について
-
ポケモンカード
-
プロアクションリプレイmax2の...
-
メフィスト賞の応募歴は無しだ...
-
MusicVampireの招待コード
-
白猫プロジェクトのリセマラ
-
GPS位置情報で2点の中間地点の...
-
セカンドライフ アカウント登録
-
月末日に、各月の合計温度を出す
-
Google Mapsを利用して屋根の面...
-
UWSC使用中に画面クリックする...
-
僕は、今19歳です 僕は、小さい...
-
Googleマップなどの地図サービ...
-
認証コードの入力の仕方教えて...
-
荒野行動の引き継ぎについて質...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルVBA 作業後に選択範囲...
-
別のフォームで記述している関...
-
Sub Auto_Open() 実行されない
-
最小化ボタンで最小化したフォ...
-
ACCESSで別DBにあるクエリを...
-
Excelで、チェックボックスにチ...
-
円の中に等間隔に線を引くには
-
VBAでのユーザフォームの表示有...
-
エクセル マクロ 別シートから...
-
Excel vba 条件分岐 空白セルが...
-
ascW関数の結果がおかしい
-
Excelのマクロ実行後に動作が重...
-
メニューバーのイベントが2回...
-
ExcelVBAで毎月月初の最初にBoo...
-
Excel VBAのステップイン
-
ExcelVBA 日付変更
-
excel2010でボタンが反応しなく...
-
エクセルVBAのコードで質問です...
-
ExcelVBA ドロップボックスで月...
-
エクセル VBA
おすすめ情報