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
No.1
- 回答日時:
全部追うのは大変なのでコードはほとんど見てませんけど、、、
Lookat:=xlPart って事は完全一致では無いですよね?
myWord にどんなキーワードを入れた時に、どんな対象外のデータが含まれてくるのでしょう?
部分一致で検索をかけています、
たとえば、[アンネ・ゾフィー・ムター]とキーワードを入力すると
データ行が13行、転記され、最終行にキーワードを全く含まない
行が出ます。
データの数は関係ないみたいです、50以上のデータでも合っている時は合っているし、10行のデータでもだめな時はだめなようです
No.2ベストアンサー
- 回答日時:
こんにちは。
そのコードから、エラーを見つけるのはちょっと厳しいですね。
かなり、苦労して書かれているのは分かるのですが、コードが読みにくいです。ただ、Find メソッドが原因ではありませんね。原因は、位置をワークシートに置くことだと思います。
本当は、パターンに入れれば、もっと簡単に書けるはずですね。
Sub コピー1()
-> Sheets("検索").Range("A3:L5000,L1").ClearContents
この場所がヘンです。
新規検索()の Call コピー1 の前に入れるべきですね。
Sheets("検索").Range("A3:L5000,K1, L1").ClearContents
で、K1 と加えます。消去したときに、代入値 K1は残っています。
後は、Range("収録表") のように領域を取ってしまって検索しますから、検索行が、ダブらなければよいのですが。
ひとつのプロシージャで書けば、この場合、受け取ったセルの場所は、変数に置きます。私のコードも参考にされるなら、書いてみますが、このまま通れば、それでもよいと思います。
この回答への補足
Wendy02さん、有難うございます。
なかなか、すっきりしたプログラムがかけなくて、、、
ご指摘のように、
Sheets("検索").Range("A3:L5000,K1, L1").ClearContents
は、新規検索()の Call コピー1 の前ですね、うまくいかずに
何回も書き直して、ミスしたみたいです。
、、で、そのように訂正して実行してみましたが、同じミスが出ます
おっしゃるように、固定した領域でなしに可変領域にしてみようと思います。
また、結果を報告します。
すみません、補足を追加する方法が解らなくて、この欄に書いています
「固定した領域でなしに可変領域にしてみようと思います。」
ということで
Range("収録表")を Range("A2").CurrentRegion
に変えてみましたが、結果は同じです。
、、、わかりません。
No.3
- 回答日時:
こんにちは。
>最終行にキーワードを全く含まない行が出ます。
この現象自体は、こちらでも、確認しています。
もう一度確認しています。私は、なるべく、今のスタイルの中で完成させてあげたいように思っています。私のコードを出しても、何もなりませんからね。
>Range("収録表")を Range("A2").CurrentRegion
いえ、これ自体は、どちらでもよいのですが、どちらかといえば、CurrentRegionのほうが良いかなって思います。今回の件とは関係ありません。
Find メソッドの問題ではないはずです。全体の問題点は、こちらは把握しているのですが、その現象自体の原因は見出していません。
それと、前回書き忘れましたが、もう一点。UserForm のことですが、単なる「検索中」の表示でしょうけれども、私が見た限りは、逆に、それがあるために、最終的な検索結果が遅くなっているようですね。ほんの数秒程度の違いですが、それも痛し痒しです。
No.4
- 回答日時:
#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
'--------------------------------------------------------------------------------------
papayuka さん
実に、きれいなプログラムを提示していただき、有難うございました。
今回のミスの原因がわかりました
myData.Find と書いて、後段に Cells.FindNext としていました
myData.FindNext と訂正して、すべて解決しました。
感謝いたします。
No.5
- 回答日時:
こんにちは。
以下の部分がヘンでしたね。このほうが楽です。
ただ、行数だけの勘定なら、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
Wendy02さん
本当に有難うございました。
まず、以下の部分のミスに気づきました。
myData.Find と書いて、次を検索で Cells.FindNext としていました MyData.FindNext と訂正したところ問題は解決しました、
Sub 新規検索()
Application.ScreenUpdating = False
Dim myData, myRng As Range
Dim myWord As String
Dim r, fRw, tRw As Long
myWord = InputBox("キーワードを入力してください")
Set myData = Range("A2").CurrentRegion
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: MsgBox ("該当データはありません")
Exit Sub
End If
fRw = myRng.Row
Sheets("検索").Range("A3:L5000").ClearContents
Set motorng = Application.Intersect(myData, ActiveCell.EntireRow)
Set sakiRng = Sheets("検索").Range("A65535").End(xlUp).Offset(1)
motorng.Copy sakiRng
Do Until tRw = fRw
Set myRng = myData.FindNext(after:=ActiveCell.Offset(1))
If myRng <> "" Then
Application.Goto Cells(myRng.Row, 1), True
End If
tRw = myRng.Row
Set motorng = Application.Intersect(myData, ActiveCell.EntireRow)
Set sakiRng = Sheets("検索").Range("A65535").End(xlUp).Offset(1)
motorng.Copy sakiRng
Loop
Sheets("検索").Visible = True
Sheets("検索").Activate
r = Range("A65536").End(xlUp).Row
Range("A65536").End(xlUp).EntireRow.Delete Shift:=xlUp
Range("A65536").End(xlUp).Offset(1).Select
ActiveCell.FormulaR1C1 = "=COUNTA(R3C:R[-1]C)"
MsgBox "全部で" & Range("A" & r).Value & "件ありました"
Range("A" & r).ClearContents
Application.ScreenUpdating = True
End Sub
上記に訂正しました、勉強になりました、感謝!
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Excel(エクセル) 日付で矢印マクロ 4 2023/07/25 16:47
- Visual Basic(VBA) エクセルVBAのコードで質問です。 下のコードはJ16の文字列をB3を起点とする範囲から探して、見つ 5 2023/04/07 11:07
- Visual Basic(VBA) オブジェクトが見つかりません 1 2023/06/24 19:43
- Visual Basic(VBA) このVBAでExcelアプリケーションを作成は必要ですか? 3 2023/07/19 21:13
- Visual Basic(VBA) Excelで下記のようにマクロを作ったところ、一回目は実行できたのですが、二回目以降「実行時エラー1 1 2022/03/25 08:08
- Visual Basic(VBA) VBA 請求書自動作成 3 2022/04/24 01:58
- Excel(エクセル) マクロで最終行から上に検索を逆にしたい 1 2022/05/17 18:27
- Visual Basic(VBA) エクセル VBA 処理スピードを上げたいのですが。 6 2023/03/31 20:52
- Visual Basic(VBA) まとめシートから集計シートへA列のコードが一致したら1行コピーするマクロをネット上で見つけました。こ 1 2022/08/30 14:11
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルのデーターが2か月前の...
-
エクセルVBA、別ブックへ転記す...
-
【マクロ】顧客番号にて一致さ...
-
エクセル共有したが、アクセス...
-
エクセル②
-
(マクロ)データをAブックからB...
-
Excelでセルの値が同じか...
-
エクセルを使っていて2024/5/15...
-
指定文字の間に
-
Microsoft 365の Excel を使用...
-
エクセルの計算
-
エクセルでの作業計算方法について
-
Excelで全角を半角にしたいので...
-
エクセル関数に詳しい方教えて...
-
Googleスプレッドシートでファ...
-
エクセル 文字を増やしたい。
-
はがきについて。
-
エクセルの暗号化なしのバーの...
-
【マクロ】必要な項目(列)の...
-
Excel
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
SSDにTRIMをしたいのですがSSD...
-
長い複数の検索語を分割しない...
-
スポンサーリンクは消せません...
-
Google検索結果を全部見たいです
-
Googleの画像検索で、「~に一...
-
真言宗の晋山式について
-
OR検索??AND検索??
-
Word文書内の語句が検索されません
-
特定のキーワードを検索禁止に...
-
Outlook2007での本文検索方法を...
-
html内のコメントは検索されな...
-
VBAのファインドメソッドで検索...
-
OKwaveの一覧のページ
-
欠字の検索方法ってありますか?
-
Google と Yahoo の検索結果の違い
-
LINEでID検索に引っかからない
-
広辞苑について
-
人名や会社名の検索方法を教え...
-
名阪自動車道の通行量について
-
Google Colaboratoryでマウント...
おすすめ情報