VBAのファインドメソッドで検索すると対象外のデータが選択されることがある
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