findは動くがfindnextがマクロで動きません。記述は同じはずなのですが…

Question

sheet1の●列のセルをsheet2の◆列で検索し、ヒットがあればsheet1の同行数列後の数値をsheet2のヒット行数列後のセルに入力する…というマクロを作っています。
sheet2でのヒットが複数あるため、findとfindnextを利用しているのですが
findのみの場合は動くのに、findnextについては全く反応しないマクロが出来てしまいました。
不格好な記述ですが、原因がお解りになる方がいらっしゃいましたらご教授頂ければ幸いです。
findとfindnextのルールは調べた限りでは守っているはずなのですが、原因がわからず困っております。


Sub test()

    Application.ScreenUpdating = False
   
   
Dim i As Long
Dim ii As Long
Dim p As Long

    Worksheets(1).Activate
    With ActiveSheet
    x = .UsedRange.Cells(.UsedRange.Count).Row
End With
    Worksheets(2).Activate
    With ActiveSheet
    k = .UsedRange.Cells(.UsedRange.Count).Row
End With
  
For i = 1 To x
  
    Dim lngYLine As Long
    Dim intXLine As Integer
    Dim Obj As Object
 
  Dim fnd As Range
  Dim fnd2 As Range
  Dim adr As String

  Set Obj = ActiveWorkbook.Worksheets(2).Range("I1", Cells(k, 9)).Find(What:=ActiveWorkbook.Worksheets(1).Cells(i, 1).Value, LookIn:=xlValues, LookAt:=xlPart)

 
  If Obj Is Nothing Then '見つからなかった場合の処理
ActiveWorkbook.Worksheets(1).Cells(i, 1).Interior.ColorIndex = 3
  Else '見つかった場合の処理
ActiveWorkbook.Worksheets(1).Cells(i, 1).Interior.ColorIndex = 4
  Set fnd = ActiveWorkbook.Worksheets(2).Range("I1", Cells(k, 9)).Find(What:=ActiveWorkbook.Worksheets(1).Cells(i, 1).Value, LookIn:=xlValues, LookAt:=xlPart)
    adr = fnd.Address
   
q = Obj.Row

       p = ActiveWorkbook.Worksheets(1).Cells(i, 18).Value

ActiveWorkbook.Worksheets(2).Cells(q, 14) = p
  
  End If

'=======
  Do
    Set fnd2 = ActiveWorkbook.Worksheets(2).Range("I1", Cells(k, 9)).FindNext(fnd)
    If fnd2.Address = adr Then '上書きしたfndのアドレスが最初のfndアドレスと一緒なら終了
      Exit Do
    Else 'そうでなければ以下の処理を続ける
ActiveWorkbook.Worksheets(1).Cells(i, 1).Interior.ColorIndex = 4
q = Obj.Row

       p = ActiveWorkbook.Worksheets(1).Cells(i, 18).Value
ActiveWorkbook.Worksheets(2).Cells(q, 14) = p
    End If
  Loop

'=======

    Next i

    Application.ScreenUpdating = True


End Sub

WindFaller · Accepted Answer

こんにちは。もう2名も先に回答がついたので、これで十分なのですが、思うことがあり参加させていただきます。ふつうは、　範囲.Find ->見つかれば、->範囲.FindNext 範囲を新たに設定することはないので、通常はWith ステートメントでつなぎます。 Set Obj = ActiveWorkbook.Worksheets(2).Range..Find(... Set fnd = ActiveWorkbook.Worksheets(2).Range..Find(.... Do Set fnd2 = ActiveWorkbook.Worksheets(2).Range.. FindNext(fnd)　'* Loop *これは、戻り値をfnd2にしたらつながりませんね。 > Worksheets(1).Activate >　With ActiveSheet >　　x = .UsedRange.Cells(.UsedRange.Count).Row >　End With 決して、UsedRangeで最後尾を求める方法が悪いわけではないのですが、最後のセルのとり方として、とんでもない数字が入る要素があるのと、これで検索値を求めると、空白値が入り込む要素が高いです。検索データ列も、被検索列もともに、一列のみのようでしたら、Endプロパティで求めたほうがよいです。また、私は、ループで使う変数は、短めにするということにしています。わかりにくくしているのは、最初、変数を全体的に有効利用していないからだと思いました。#2さんの回答と、だいたい注目点はおなじだと思っていますが、もしかしたら、解釈が違っているかもしれません。私は、検索のxlPart の件ですが、xlWholeにして、検索値 &"*" とワイルドカードを使うことがあります。ただ、一般的に文字列の検索に利用し、数値は、xlWholeで、xlPart は使いません。一旦、検索したものを、桁などを処理して正しいか検査してから、検索値として扱います。こんなふうに直してみました。 '// Sub Test2() 　Dim sh1 As Worksheet 　Dim sh2 As Worksheet 　Dim o As Object ''　Dim fnd As Range　'使うのを辞めました。　Dim Rng As Range 　Dim r As Range 　Dim k As Long 　Dim i As Long 　Dim x As Long 　Dim FirstAddress As String 　Set sh1 = ActiveWorkbook.Worksheets("Sheet1") 　Set sh2 = ActiveWorkbook.Worksheets("Sheet2") 　With sh2 　　Set Rng = .Range("I1", .Cells(Rows.Count, "I").End(xlUp)) 　End With 　With sh1 　　x = .Cells(Rows.Count, 1).End(xlUp).Row 　End With 　For i = 1 To x 　　Set r = sh1.Cells(i, 1) 　　If r.Value <> "" Then 　　　Set o = Rng.Find(What:=r.Value, LookIn:=xlValues, LookAt:=xlPart) 　　　If Not o Is Nothing Then 　　　　FirstAddress = o.Address 　　　　Do 　　　　　r.Interior.ColorIndex = 4 　　　　　sh2.Cells(o.Row, 14).Value = sh1.Cells(i, 18).Value 　　　　　Set o = Rng.FindNext(o) 　　　　Loop While Not o Is Nothing And o.Address <> FirstAddress 　　　Else 　　　　r.Interior.ColorIndex = 3 　　　End If 　　End If 　Next End Sub

fujillin · Answer

こんにちはすでに指摘がありますが、うまくいかない原因になりそうなのは、 1）Doループの中で＞Set fnd2 = ActiveWorkbook.Worksheets(2).Range("I1", Cells(k, 9)).FindNext(fnd) としているため、fndの内容が常に一定（変化しない）なので、fnd2も同じ値を取り続けることになり、対象が複数存在する場合はループを抜けなくなる。 2）検索処理の手順全体が＞If Obj Is Nothing Then ＞Else ＞End If ＞Do ＞Loop という構造になっていますが、見つからない場合（Obj is Nothing)でも、後段のDoループの処理は実行されてしまいます。・・・といったところでしょうか？そのほかにも、 3）検索値（Worksheets(1)のA列？）の値に空白がある場合にも空白値で検索するけれど・・？ 4）検索方法がxlPartなので、違う値でも複数回ヒットする可能性があり、最後にヒットした時の値で上書きされる。（データの性質上、3）、4）のようなことは起こり得ないのかもしれませんが）・・・などが気になりますが、これで結果が異なる可能性があるものの、処理が止まることは無いと思います。また、処理内容とは関係がありませんが、記述方法として、属性値を利用するのに同じドット記法を何度も繰り返していたり、あるいは、同じ処理を複数回繰り返し記述しているように見えますが、変数を利用したり、処理順序を工夫したりすることで、もう少し簡潔に記載できそうな気がします。ちゃんと確認していないので、行や列がずれてしまっているかも知れませんが、以下のような雰囲気でも処理ができるのではないかと思います。 ※ ご提示のコードにはありませんが、セル値が空白の場合に検索をスキップする処理を勝手に追加しています Sub test() Dim sh1 As Worksheet, sh2 As Worksheet Dim searchRange As Range, fnd As Range Dim rw As Long, cellColor As Integer Dim addr As String ' 変数の初期設定 Set sh1 = Worksheets(1) Set sh2 = Worksheets(2) Set searchRange = sh2.Cells(1, 9).Resize(sh2.Cells(Rows.Count, 9).End(xlUp).Row) ' 元シートの各行でループ For rw = 1 To sh1.Cells(Rows.Count, 1).End(xlUp).Row 　cellColor = 4 　' 空セルの場合はスキップ　If sh1.Cells(rw, 1) <> Empty Then 　　Set fnd = searchRange.Find(What:=sh1.Cells(rw, 1).Value, LookIn:=xlValues, LookAt:=xlPart) 　　' 検索できない場合の処理　　If fnd Is Nothing Then 　　　cellColor = 3 　　' 検索できた場合の処理　　Else 　　　addr = fnd.Address 　　　Do 　　　　sh2.Cells(fnd.Row, 14).Value = sh1.Cells(rw, 18).Value 　　　　Set fnd = searchRange.FindNext(fnd) 　　　Loop While Not fnd Is Nothing And fnd.Address <> addr 　　End If 　　sh1.Cells(rw, 1).Interior.ColorIndex = cellColor 　End If Next rw End Sub

めぐみん_ · Answer

ヘルプより
FindNext メソッド

Find メソッドによって開始された検索を継続します。

－－－－－－－－

とあります。
なら原因は多分

＞Set fnd = ActiveWorkbook.Worksheets(2).Range("I1", Cells(k, 9)).Find(What:=ActiveWorkbook.Worksheets(1).Cells(i, 1).Value, LookIn:=xlValues, LookAt:=xlPart)

＞Set fnd2 = ActiveWorkbook.Worksheets(2).Range("I1", Cells(k, 9)).FindNext(fnd)

受け取る変数が違うからかも知れません。
（シートの状況がわからないので検証してませんが）

もし既に確認済みならほっといて良いですよ。

findは動くがfindnextがマクロで動きません。記述は同じはずなのですが…

こんにちは。

こんにちは

ヘルプより

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

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

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

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

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

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