検索マクロ

質問

下記のマクロは、検索文字でシートを検索し、そのセルアドレス情報を
シートを追加して表示する機能ですが、ＢＯＯＫ全体に検索し、シート名を含めて表示するには、ｘｘｘｘのところをどのように変更すればいいか。よろしくお願いします。
Sub kennsaku_Macro1()
Dim ret
Dim r As Range
Dim adr As String
Dim cnt As Long
Dim psw As Boolean
Dim mySht, adSht, ws As Worksheet
Set mySht = ActiveSheet
ret = Application.InputBox("検索文字列を入力してください")
If TypeName(ret) <> "Boolean" Then
With mySht.Cells
Set r = .Find(ret, LookIn:=xlValues, lookat:=xlPart)
If Not r Is Nothing Then
adr = r.Address
cnt = 2 '2行目から表示
xxxxxxxxxxxxx
For Each ws In Worksheets
If ws.Name = "検索結果" & ret Then
psw = True
Exit For
End If
Next ws
If psw Then
Set adSht = ws
adSht.Cells.ClearContents
Else
Set adSht = Worksheets.Add
adSht.Name = "検索結果" & ret
End If
adSht.Cells(cnt, 1).Value = r.Value
adSht.Cells(cnt, 2).Value = xxxx 'シート名
adSht.Cells(cnt, 3).Value = adr
Do
Set r = .FindNext(r)
If r.Address = adr Then
Exit Do
Else
cnt = cnt + 1
adSht.Cells(cnt, 1).Value = r.Value
adSht.Cells(cnt, 2).Value = xxxx 'シート名
adSht.Cells(cnt, 3).Value = r.Address
End If
Loop
End If
End With
End If
adSht.Cells(1, 1).Value = "項目"
adSht.Cells(1, 2).Value = "シート名"
adSht.Cells(1, 3).Value = "セルアドレス"
mySht.Activate
End Sub

回答No.3

mitarashi · ベストアンサー

興味本位にこしらえてみましたので、ご質問のコード構成は全く気にしておりませんが、お役に立つところがあれば、ご参考にしてください。
検索文字列入力部分は盛り込んでありません。シートを都度挿入するのは厄介ではないでしょうか？
Sub searchAllSheet()
Dim sh As Worksheet
Dim matchString As Variant
Dim hitRange As Range, myArea As Range, myCell As Range, destRange As Range
Const outPutSheetName As String = "検索結果"

matchString = "a"
Sheets.Add
ActiveSheet.Name = outPutSheetName
Set destRange = Sheets(outPutSheetName).Range("a1")
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> outPutSheetName Then
Set hitRange = myFind(sh.UsedRange, matchString, xlPart)
If Not hitRange Is Nothing Then
For Each myArea In hitRange.Areas
For Each myCell In myArea.Cells
With destRange
.Value = myCell.Value
.Offset(0, 1).Value = myCell.Parent.Name
.Offset(0, 2).Value = myCell.Address
End With
Set destRange = destRange.Offset(1, 0)
Next myCell
Next myArea
End If
End If
Next sh
End Sub
'検索でヒットしたセル群を戻す関数
Private Function myFind(target As Range, findValue As Variant, findMode As Variant) As Range
Dim c As Range
Dim firstAddress As String

With target
Set c = .Find(findValue, LookIn:=xlValues, Lookat:=findMode, MatchCase:=False, MatchByte:=False)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If myFind Is Nothing Then
Set myFind = c
Else
Set myFind = Union(c, myFind)
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Function

お礼

目的達成
どうもとてもすばらしいもの、ありがとうございます。

回答No.2

fujillin

現状は、シート内（アクティブシート）の検索と、結果表示のシートを設定する処理が交錯していますので、このままで1行追加とかではちょっと難しいかと・・・

全体を、
0）検索文字の入力
1）検索結果表示用のシートを設定する処理
2）1枚のシート内検索（と記録）処理

　というふうに、まず構成を切り分けておいてから、
3）↑の2）の処理の部分をブック内の各シート（結果表示用シートを除く）
　　に対してループする
という形に修正するのが良さそうに思われます。

ちなみに、現状では対象シートはmySht（=アクティブシート）になっていますから、シート名はmySht.Nameで取得可能です。

補足

ヒントありがとうございます。
全部のシートを対象にまわすやりかたをヒントください。そのときｂｏｏｋ名は必要ですか。

回答No.1

n-jun

どのような実行をしたいのか、シート構成等を踏まえ提示されては如何でしょうか？