VBAのファインドメソッドで検索すると対象外のデータが選択されることがある

Question

CDのリスト表（12列で、現在2269行 範囲名"収録表"）Sheets("データ")から,キーワードで該当ディスクを検索し、
結果をSheets("検索")に転記する、プログラムを作りましたが、
仮に、該当データが10件、転記されたとして
そのデータを見ると、中に1件、対象外のデータがはいっている事が
たまにあります、いろんな原因を考えてみましたがわかりません。
もともと、VBAのファインドメソッドが、こんなエラーを起こしやすいのか、、、（そんな事、ないよね）
どなたか、教えてください。
下が、プログラムです

Sub 新規検索()
    Application.ScreenUpdating = False
    Dim myData, myRng As Range
    Dim myWord As String
    myWord = InputBox("キーワードを入力してください")
    データ処理中F.Show vbModeless
    データ処理中F.Repaint
    Set myData = Range("収録表")
    Set myRng = myData.Find(What:=myWord, LookIn:=xlValues, _
    Lookat:=xlPart, MatchCase:=False, MatchByte:=False)
    If myWord = "" Then
        MsgBox ("キーワードを入力してください")
        Exit Sub
    End If    
    If Not myRng Is Nothing Then
        Application.Goto Cells(myRng.Row, 1), True
    Else: Unload データ処理中F
        MsgBox ("該当データはありません")        
        Exit Sub
    End If
    Sheets("検索").Range("K1") = myRng.Row   '一番最初の検索値のRow

    Call コピー1   
       
    Do Until Range("K1") = Range("L1")
    　  Call 次を検索    
    Loop
    Call 検索終了
    Unload データ処理中F
    Application.ScreenUpdating = True
End Sub

Sub 次を検索()
    Dim myData, myRng As Range
    
    Sheets("データ").Select
    Set myData = Range("収録表")
    Set myRng = Cells.FindNext(after:=ActiveCell.Offset(1))
    
    If myRng <> "" Then
        Application.Goto Cells(myRng.Row, 1), True
    End If
    Sheets("検索").Range("L1") = myRng.Row   '2番目以降の検索値のRow
　
    Call コピー2    
End Sub

Sub コピー1()
    Sheets("検索").Range("A3:L5000,L1").ClearContents
    Dim myData As Range
    
    Set myData = Range("収録表")
    Set motorng = Application.Intersect(myData, ActiveCell.EntireRow)
    
    Set sakiRng = Sheets("検索").Range("A65535").End(xlUp).Offset(1)
    motorng.Copy sakiRng
    Sheets("検索").Visible = True
    Sheets("検索").Activate
End Sub

Sub コピー2()
    Dim myData As Range    
    Set myData = Range("収録表")
    Set motorng = Application.Intersect(myData,　　　ActiveCell.EntireRow)    
    Set sakiRng = Sheets("検索").Range("A65535").End(xlUp).Offset(1)    
    motorng.Copy sakiRng
    Sheets("検索").Visible = True
    Sheets("検索").Activate    
End Sub

Sub 検索終了()
    Dim r As Long
    r = Range("A65536").End(xlUp).Row
    Range("A" & r).Select
    ActiveCell.FormulaR1C1 = "=COUNTA(R3C:R[-1]C)"
    MsgBox "全部で" & Range("A" & r).Value & "件ありました"
        
    Range("A65535").End(xlUp).EntireRow.ClearContents
    Call 行頭表示
End Sub

Wendy02 · Accepted Answer

こんにちは。

そのコードから、エラーを見つけるのはちょっと厳しいですね。
かなり、苦労して書かれているのは分かるのですが、コードが読みにくいです。ただ、Find メソッドが原因ではありませんね。原因は、位置をワークシートに置くことだと思います。

本当は、パターンに入れれば、もっと簡単に書けるはずですね。

Sub コピー1()
-> Sheets("検索").Range("A3:L5000,L1").ClearContents
この場所がヘンです。

新規検索()の Call コピー1　の前に入れるべきですね。

Sheets("検索").Range("A3:L5000,K1, L1").ClearContents
で、K1 と加えます。消去したときに、代入値　K1は残っています。

後は、Range("収録表")　のように領域を取ってしまって検索しますから、検索行が、ダブらなければよいのですが。

ひとつのプロシージャで書けば、この場合、受け取ったセルの場所は、変数に置きます。私のコードも参考にされるなら、書いてみますが、このまま通れば、それでもよいと思います。

Wendy02 · Answer

こんにちは。

以下の部分がヘンでしたね。このほうが楽です。
ただ、行数だけの勘定なら、r -2 でもよいはずですが...。

Sub 検索終了()
　　Dim r As Long
　　Dim i As Long
　　r = Range("A65536").End(xlUp).Row
　　i = WorksheetFunction.CountA(Range("A3:A" & r))
　　 MsgBox "全部で" & i & "件ありました"
　　Call 行頭表示
End Sub

papayuka · Answer

#1です。

> 最終行にキーワードを全く含まない行が出ます。

必ず最終行って事なら、Find の After位置とか Until条件とかを疑いますけど、何れにしても貴方が提示されたコードには問題がありそうです。
下記はざっとコードをおって、同様の処理を書いたつもりですが、出力結果件数が貴方のコードを実行した場合と異なりました。
具体的な事例として

「データ」シートに xx1～xx9 というデータが "連続してある場合"、「xx」で検索すると貴方のコード実行結果は

　xx1,xx3,xx5,xx7,xx9

となります。

少なくとも「Sub 次を検索()」の

Set myRng = Cells.FindNext(after:=ActiveCell.Offset(1))　は
　　　　　　　　↓
Set myRng = Cells.FindNext(after:=ActiveCell)　にしないとダメかと思います。


'--------------------------------------------------------------------------------------
Sub Test()
Dim myData, myRng As Range, cnt As Long
Dim myWord As String, firstAddr As String

myWord = Application.InputBox("キーワードを入力してください", "検索値？", Type:=2)
If myWord = "False" Then Exit Sub
If myWord = "" Then
　 MsgBox "キーワードを入力してください", vbCritical, "検索値"
　 Exit Sub
End If

With Worksheets("データ").Range("A1").CurrentRegion
　　Set myRng = .Find(myWord, .Cells(1, 1), LookIn:=xlValues, _
　　　　　　　　　　　Lookat:=xlPart, MatchCase:=False, MatchByte:=False)
　　If Not myRng Is Nothing Then
　　　　データ処理中F.Show vbModeless: cnt = 0
　　　　myCaption = データ処理中F.Caption
　　　　firstAddr = myRng.Address
　　　　Worksheets("検索").Range("A3:L65536").ClearContents
　　　　Do
　　　　　　myRng.EntireRow.Copy Destination:=Worksheets("検索"). _
　　　　　　　　　　　　　Range("A65536").End(xlUp).Offset(1, 0).EntireRow
　　　　　　cnt = cnt + 1
　　　　　　データ処理中F.Caption = myCaption & ": " & cnt & "件発見"
　　　　　　データ処理中F.Repaint
　　　　　　Set myRng = .FindNext(myRng)
　　　　Loop While Not myRng Is Nothing And myRng.Address <> firstAddr
　　　　Unload データ処理中F
　　Else
　　　 MsgBox "「" & myWord & "」は見つかりません。", vbExclamation, "NotFound"
　　　 Exit Sub
　　End If
End With
MsgBox "全部で" & cnt & "件ありました", vbInformation, "発見件数"
End Sub
'--------------------------------------------------------------------------------------

Wendy02 · Answer

こんにちは。

>最終行にキーワードを全く含まない行が出ます。

この現象自体は、こちらでも、確認しています。
もう一度確認しています。私は、なるべく、今のスタイルの中で完成させてあげたいように思っています。私のコードを出しても、何もなりませんからね。

>Range("収録表")を　Range("A2").CurrentRegion
いえ、これ自体は、どちらでもよいのですが、どちらかといえば、CurrentRegionのほうが良いかなって思います。今回の件とは関係ありません。

Find メソッドの問題ではないはずです。全体の問題点は、こちらは把握しているのですが、その現象自体の原因は見出していません。
それと、前回書き忘れましたが、もう一点。UserForm　のことですが、単なる「検索中」の表示でしょうけれども、私が見た限りは、逆に、それがあるために、最終的な検索結果が遅くなっているようですね。ほんの数秒程度の違いですが、それも痛し痒しです。

papayuka · Answer

全部追うのは大変なのでコードはほとんど見てませんけど、、、
Lookat:=xlPart って事は完全一致では無いですよね？

myWord にどんなキーワードを入れた時に、どんな対象外のデータが含まれてくるのでしょう？

VBAのファインドメソッドで検索すると対象外のデータが選択されることがある

こんにちは。

この回答への補足

こんにちは。

#1です。

こんにちは。

全部追うのは大変なのでコードはほとんど見てませんけど、、、

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

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

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

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