【エクセルVBA】FindNextで検索した結果の表示の仕方

Question

こんにちは、趣味でエクセルVBAを勉強し始めたのですが、タイトルの方法でうまくいかずに困っています。教えていただけますと嬉しいです。 <やりたいこと> シート1のセルA1に入力したキーとなる文字列で、シート2～シート5を検索して、ヒットしたセルの4列横の文字列を、シート1のセルA3から下に書き込んでいきたいです。 <現在> 色々と試行錯誤して、コードを書いたのですが、無限ループになってしまいます。エクセルVBAの本の通りに書いたつもりです。何度見てもコードは間違えていないように見えるのですが、必ずエラーになってしまいます。自分では思いこんでいて気づかない間違いなどがあるのかと思い、掲示板に書かせてもらいました。お分かりになる方がいらっしゃったら、教えてください。よろしくお願いいたします。エラーになる箇所は、下のコードのうち、◆の箇所です。 <コード> Sub checksheet() Dim i, j As Integer Dim sheetname As String Dim key As String Dim myrange As Range Dim myrange2 As Range Dim myaddress As String Dim strrange As Range key = Worksheets(1).Cells(1, 1).Value sheetname = ActiveSheet.Name j = 3 For i = 2 To Worksheets.Count sheetname = Worksheets(i).Name Worksheets(sheetname).Select Set myrange = Range("A1").CurrentRegion myrange.Offset(1).Resize(myrange.Rows.Count - 1).Select Set srtrange = Range("A2:A10") Set myrange2 = srtrange.Find(what:=key, LookIn:=xlValues) If Not myrange2 Is Nothing Then Do Worksheets(1).Cells(j, 1).Value = myrange2.Offset(, 4).Value ◆Set myrange2 = srtrange.FindNext(after:=myrange2) j = j + 1 If j = 100 Then 　　　　　’無限ループ対策 Exit Sub End If Loop Until myrange2.Address = myaddress Else End If Next i End Sub

めぐみん_ · Accepted Answer

ループ終了条件の

＞Loop Until myrange2.Address = myaddress

にある変数：myaddress って変数の宣言をしたあとで何も値を代入してないから無限ループになるでしょうね。

If Not myrange2 Is Nothing Then
 myaddress = myrange2.Address ' ここで myaddress に最初に見つかったアドレスを代入しておく。
Do

◆についてはExcelなしのOSなので検証は出来ませんけど。
少なくともエラーでって事なら『どんなエラー内容が表示されるのか』は情報として必要かも。

WindFaller · Answer

基本的なことですが、
Dim key As String
Dim myrange As Range
Dim myrange2 As Range
Dim myaddress As String
Dim strrange As Range

わざわざ、変数を宣言しているのですから、ここに工夫をして、大文字・小文字を組み合わせましょう。
そうすれば、変数名のミスに気が付きます。最後には、
Option Explicit
を入れれば、確実に分かります。

そして、エラーの原因は、strRange でしょうけれども、
◆Set myrange2 = srtrange.FindNext(after:=myrange2)
srt となって、str ではありません。それら(複数)を直したらエラーは消えます。

それと、
If j = 100 Then
 '無限ループ対策
 Exit Sub
End If
Find メソッドで無限ループ対策というのは、ほとんどないことですが、万が一に必要な時は、
DoEvents を用いて、Escape ブレークを入れられるようにします。

>Set srtrange = Range("A2:A10")
>Set myrange2 = srtrange.Find(what:=key, LookIn:=xlValues)
8個のセルで、Findメソッドは大掛かりすぎますね。For Each ～ in [領域]でも済むと思います。

ところで、話が飛びますが、
>趣味でエクセルVBAを勉強し始めたのですが、
この言葉がなかったら、書き加えることはなかったのですが、一応、こういうものがあります、とだけお教えします。
今回のコードは、定番がヘルプでは丸々出ていて、それを貼り付けるだけで済んだかもしれません。私は、未だにこの定番の組み込みコードを覚えていません。

ダウンロード版ヘルプより(中身は英語のみ)　GitHubに出ているというのは変ですが。
//XLVBACon.chm//
https://github.com/OfficeDev/VBA-content/blob/05ff9681074194e2f66f1d8ee36acceb7a906b6b/VBA/Offline-Docs/XLVBACon.chm

With Worksheets(1).Range("a1:a500")
　Set c = .Find(2, lookin:=xlValues)
　If Not c Is Nothing Then
　　firstAddress = c.Address
　　Do
　　　c.Value = 5
　　　Set c = .FindNext(c)
　　Loop While Not c Is Nothing And c.Address <> firstAddress
　End If
End With

tom04 · Answer

こんばんは！

他の方がお考えになったコードに手を付けるのは好みでないので
最初から勝手にやってみました。

Sheet2以降のすべてのシートのA2～A10セルの範囲を検索すればよいのですね。

一例です。

Sub Sample1()
　Dim k As Long, cnt As Long
　Dim myRng As Range, FoundCell As Range, FirstCell As Range
　Dim wS As Worksheet
 
　　With Worksheets(1)
　　　cnt = 2
　　　For k = 2 To Worksheets.Count
　　　　Set wS = Worksheets(k)
　　　　Set myRng = wS.Range("A1:A10") '//★//
　　　　　Set FoundCell = myRng.Find(what:=.Range("A1"), LookIn:=xlValues, lookat:=xlWhole)
　　　　　　If Not FoundCell Is Nothing Then
　　　　　　　Set FirstCell = FoundCell
　　　　　　　GoTo 処理
　　　　　　　Do
　　　　　　　　Set FoundCell = myRng.FindNext(after:=FoundCell)
　　　　　　　　　If FoundCell.Address = FirstCell.Address Then Exit Do
処理:
　　　　　　　　　cnt = cnt + 1
　　　　　　　　　.Cells(cnt, "A") = FoundCell.Offset(, 4)
　　　　　　　Loop
　　　　　　End If
　　　Next k
　　End With
End Sub

※　コード内の「★」の部分のように範囲は各シートのA1～A10セルとしています。
A2セルからの範囲指定の場合、仮にA2セルと他のセルに複数該当データがヒットした場合
A2セルがそのシートの最後に表示されてしまいます。
（なぜそうなるのかは当方も判りません）
1行目は項目行でSheet1のA1セルと同じデータはない！という考えです。

表示順が変わってもよいのであれば
範囲をA2～A10セルに変更してみてください。m(_ _)m

【エクセルVBA】FindNextで検索した結果の表示の仕方

基本的なことですが、

こんばんは！

ループ終了条件の

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

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

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

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

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

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