[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数シート間の検索』（samikou2003）
ＶＢＡの知識はあまりなく、ネットで検索しながら次のマクロを記述しました。 ただし、内容はほとんど理解できていません。
Sub 検索() ' ' 検索 Macro ' マクロ記録日 : 2010/7/29 ユーザー名 : '
'
Dim C As Range
Dim MOJI As String
Dim RESPONSE As VbMsgBoxResult
With Worksheets("第２")
MOJI = InputBox("検索文字入力")
If MOJI <> "" Then
Set C = .Cells.Find(MOJI, , LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
If Not C Is Nothing Then
C.Font.ColorIndex = 3
Application.Goto C, scroll:=False
RESPONSE = MsgBox("次を検索しますか？", vbYesNo + vbQuestion, "検索続行")
Do While RESPONSE = vbYes
C.Font.ColorIndex = xlAutomatic
Set C = .Cells.FindNext(C)
C.Font.ColorIndex = 3
Application.Goto C, scroll:=False
RESPONSE = MsgBox("次を検索しますか？", vbYesNo + vbQuestion, "検索続行")
Loop
MsgBox ("検索を終了しました")
C.Font.ColorIndex = xlAutomatic
Else
MsgBox MOJI & "は、ありません。。"
End If
End If
End With
End Sub
マクロ自体はきちんと動作し、とりあえず Worksheets("第２") 内の検索は
うまくで きるのですが、これを複数のシートにまたがって検索できるように改造
したいのです。
シートは"第１"〜"第１０"まであり、今後も増える可能性があります。
検索範囲は、"第２"から最後（現在は第１０）のシートまでとしたいのです。
バージョンは、Excel2003,WindowsXP です。
大変申し訳ありませんが、ご教示いただけたら助かります。
よろしくお願いいたします。
>"第１"〜"第１０"まであり シートが左から順番にセットしてあるとして、、
Dim C As Range Dim MOJI As String Dim RESPONSE As VbMsgBoxResult Dim i As Byte
MOJI = InputBox("検索文字入力")
For i = 2 To Sheets.Count
Worksheets(i).Activate
With Worksheets(i)
If MOJI <> "" Then
Set C = .Cells.Find(MOJI, , LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
If Not C Is Nothing Then
C.Font.ColorIndex = 3
Application.Goto C, scroll:=False
RESPONSE = MsgBox("次を検索しますか？", vbYesNo + vbQuestion, "検索続行")
Do While RESPONSE = vbYes
C.Font.ColorIndex = xlAutomatic
Set C = .Cells.FindNext(C)
C.Font.ColorIndex = 3
Application.Goto C, scroll:=False
RESPONSE = MsgBox("次を検索しますか？", vbYesNo + vbQuestion, "検索続行")
Loop
MsgBox ("検索を終了しました")
C.Font.ColorIndex = xlAutomatic
Else
MsgBox MOJI & "は、ありません。。"
End If
End If
End With
Next i
End Sub
こんなことで良いですか??
(kei)
kei様、ご親切にりがとうございました。 早速、教えていただいた方法を試したところ、各シートで検索を終了（"検索を終了 しました"）のメッセージボックスを閉じないと、次のシートに切り替わらないよう です。 シートの最後にヒットした値から、次を検索すると次のシートに移るようには できないでしょうか？ 重ねてのお願いで申し訳ありませんが、どうぞよろしくお願いいたします。
（samikou2003）
この種は、あまりやったことがないので、自信なし。^^;
Dim C As Range Dim MOJI As String Dim RESPONSE As VbMsgBoxResult Dim i As Byte Dim j As Integer
MOJI = InputBox("検索文字入力")
If MOJI <> "" Then
For i = 2 To Sheets.Count
Worksheets(i).Activate
With Worksheets(i)
Set C = .Cells.Find(MOJI, , LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
If Not C Is Nothing Then
C.Font.ColorIndex = 3
Application.Goto C, scroll:=False
RESPONSE = MsgBox("次を検索しますか？", vbYesNo + vbQuestion, "検索続行")
Do Until WorksheetFunction.CountIf(Cells, MOJI) - 1 = j
j = j + 1
C.Font.ColorIndex = xlAutomatic
Set C = .Cells.FindNext(C)
C.Font.ColorIndex = 3
Application.Goto C, scroll:=False
RESPONSE = MsgBox("次を検索しますか？", vbYesNo + vbQuestion, "検索続行")
If RESPONSE = vbNo Then Exit Do 'vbNo1で検索を終了させるときは、Then End
Loop
C.Font.ColorIndex = xlAutomatic
Else
MsgBox MOJI & "は、ありません。。"
End If
End With
j = 0
Next i
MsgBox ("検索を終了しました")
End If
End Sub
動きの変なとこがあるかも!!
(kei)
kei様、ご検討ありがとうございます。 急な会議が入り返事がが遅くなり、申し訳ありませんでした。 ご教示のマクロを試してみましたが、やはり、各シートの検索を終了させないと 次のシートには移らないようです。 どうしたら良いのでしょうか？ 質問ばかりで申し訳ありません。
こちらでは、次のシートに移ります。。 明日は仕事で、明後日の朝に出てきます。もう寝ます。。 それまでに、どなたかの素敵なレスが付くかも ^^ (kei)
samikou2003さん、おはよーございます。 Do Until〜Loopを整理してみました。 今度はきっとうまく動くと思います。。
Sub test()
Dim C As Range
Dim MOJI As String
Dim RESPONSE As VbMsgBoxResult
Dim i As Byte
Dim j As Integer
Dim myCn As Integer
MOJI = InputBox("検索文字入力")
If MOJI <> "" Then
For i = 2 To Sheets.Count
Worksheets(i).Activate
With Worksheets(i)
Set C = .Cells.Find(MOJI, , LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
If Not C Is Nothing Then
myCn = WorksheetFunction.CountIf(.Cells, MOJI & "*")
Do Until WorksheetFunction.CountIf(Cells, MOJI & "*") = j
j = j + 1
C.Font.ColorIndex = 3
Application.Goto C, scroll:=False
If myCn - j > 0 Then
RESPONSE = MsgBox("次を検索しますか？" & vbCrLf & _
"あと" & myCn - j & "件あります。", vbYesNo + vbQuestion, "検索続行")
Else
RESPONSE = MsgBox("次のシートを検索しますか？", vbYesNo + vbQuestion, "検索続行")
End If
C.Font.ColorIndex = xlAutomatic
Set C = .Cells.FindNext(C)
If RESPONSE = vbNo Then Exit Do
Loop
C.Font.ColorIndex = xlAutomatic
Else
MsgBox MOJI & "は、ありません。。"
End If
End With
j = 0
Next i
MsgBox ("検索を終了しました")
End If
End Sub
(kei)
こんにちは。 先に全ての該当セルを配列に入れて、そこから順次表示してみました。
○【Module1】標準モジュール Sub kota1() Dim C As Range, r() As Range Dim MOJI As String, s0 As String Dim RESPONSE As VbMsgBoxResult Dim i As Long, j As Long, n As Long
MOJI = InputBox("検索文字入力")
If MOJI = "" Then Exit Sub
j = 0
'該当セルをr()に格納
For i = 2 To Worksheets.Count
With Worksheets(i)
Set C = .Cells.Find(MOJI, , LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If Not C Is Nothing Then
s0 = C.Address
Do
j = j + 1
ReDim Preserve r(1 To j)
Set r(j) = C
Set C = .Cells.FindNext(C)
Loop Until C.Address = s0
End If
End With
Next
'r()内のセルを表示
If Not C Is Nothing Then
j = 0
Do
j = j Mod UBound(r) + 1
Application.Goto r(j), scroll:=False
r(j).Font.ColorIndex = 3
RESPONSE = MsgBox("次を検索しますか？", vbYesNo + vbQuestion, "検索続行")
r(j).Font.ColorIndex = xlAutomatic
Loop Until RESPONSE = vbNo
MsgBox ("検索を終了しました")
Else
MsgBox MOJI & "は、ありません。。"
End If
End Sub
（コタ）
kei様、コタ様 ご検討いただき、感謝しております。 すぐに試して報告しないといけないのですが、月曜日まで職場のパソコンを使用できません。 大変失礼ですが、結果は火曜日に報告させていただきます。 また、よろしくお願いいたします。
(samikou2003)
kei様、コタ様、お世話になりました。 確認がが終わりましたので、ご報告いたします。 お二人から御教示いただいたいずれの方法でも全シート検索が可能となり、当方の希望どうおりの マクロが組めそうです。 マクロの内容はよく理解できていませんが、お二人から御教示いただいたものを十分に勉強してみた いと思います。 ご親切にありがとうございました。 ところで､コタ様にもう１点だけ質問させてください。 御教示いただいたマクロですと､最終シートに検索条件に該当する値が入力されていないと「該当な し」 となってしまいます。 つまり､シート第１に「りんご」との値があっても､シート第１０（最終シート）に「りんご」の値が なければヒットしないのです。 この点，何か参考となることあれば御教示いただけたら助かります。
(samikou2003)
＞シート第１０（最終シート）に「りんご」の値が なければヒットしないのです。 あらら、これは失礼しました。
'r()内のセルを表示
If Not C Is Nothing Then
この行で、検索結果があるかどうかを判断するつもりだったのですが、Cは最終シートの結果が 残るので、このような動作をなってしまいました。 以下のように修正してください。（1つでも検索値があれば、jは正値になるので）
'r()内のセルを表示
If j > 0 Then
（コタ）
コタ様、ご教示の点修正しましたところ、見事検索が出来るようになりました。 ご親切にありがとうございました。
(samikou2003)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.