エクセル（検索結果をシートに書き出しする方法）

2010年3月27日2011年3月2日

以下のページからコピーhttp://questionbox.jp.msn.com/qa3555630.html
以下のマクロをALT＋F11でVBE画面を開き、左上のVBA Projectでシート名を右クリックし「挿入」→「標準モジュール」で表示される画面に貼り付けて下さい。マクロの実行はワークシート画面に戻って ALT＋F8でマクロ一覧を開き、マクロ名を選択して「実行」ボタンです。

勉強になりませんので解説や再修正はしません。もし修正が必要ならご自身でお願いします。

Sub 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 = 1
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 = 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 = r.Address
End If
Loop
End If
End With
End If
mySht.Activate
End Sub