VBAでExcelの文字列検索結果を出力する

Excelの検索結果はコピーできない。

調べるとVBA等でマクロを組むしかなさそうだ。

かなり古い質問だったが、こちらの回答のソースを元に少し修正してマクロを組んでみた。

'現在開いているブックの全シートを対象に文字列検索をおこなう。
'検索結果はシート「検索結果+検索文字列」に出力
'流用元:https://oshiete.goo.ne.jp/qa/3555630.html
Sub Macro1()
    
    Dim kwd
    kwd = Application.InputBox("検索文字列を入力してください")
    If TypeName(kwd) <> "Boolean" Then
        
        '検索結果のシートを探す
        Dim hasAdSht As Boolean
        For Each ws In Worksheets
            If ws.Name = "検索結果" & kwd Then
                hasAdSht = True
                Exit For
            End If
        Next ws
        Dim adSht As Worksheet
        If hasAdSht Then
            '検索結果のシートが存在したら、全セルクリア
            Set adSht = ws
            adSht.Cells.ClearContents
        Else
            '存在しなれば新規追加
            Set adSht = Worksheets.Add
            adSht.Name = "検索結果" & kwd
        End If
        
        Dim actSht As Worksheet
        Set actSht = ActiveSheet
        
        Dim cnt As Long
        cnt = 0
        
        For Each ws In Worksheets
            If ws.Name = adSht.Name Then
                '検索結果のシートはスキップ
                GoTo Continue
            End If
            With ws.Cells
                'シートを検索
                Dim r As Range
                Set r = .Find(kwd, LookIn:=xlValues, lookat:=xlPart)
                'ヒットしたら
                If Not r Is Nothing Then
                    '1件目のヒット情報出力
                    cnt = cnt + 1
                    adSht.Cells(cnt, 1).Value = ws.Name
                    adSht.Cells(cnt, 2).Value = r.Address
                    adSht.Cells(cnt, 3).Value = r.Value
                    
                    Dim adr As String
                    adr = r.Address
                    
                    Do
                        'シートを検索
                        Set r = .FindNext(r)
                        If r.Address = adr Then
                            '次のヒットが無ければ終了
                            Exit Do
                        Else
                            cnt = cnt + 1
                            adSht.Cells(cnt, 1).Value = ws.Name
                            adSht.Cells(cnt, 2).Value = r.Address
                            adSht.Cells(cnt, 3).Value = r.Value
                        End If
                    Loop
                End If
            End With
Continue:
        Next
        
    End If
    actSht.Activate
    
End Sub

使い方。

Excelの画面で Alt+F11 でマクロの編集画面を表示。
シートを選択して「コードの表示」。上記コードを貼り付ける。
Excelに戻って Alt+F8 でマクロ一覧を開いて、Macro1を実行する。

あまりテストしていないが、たぶん大丈夫だろう(適当)

しかし、なぜ未だにMicrosoftは検索結果のコピー機能を提供してくれないのだろう。

[6/16追記]

何故かこの投稿のPV(閲覧)数が多い。フリーウェアが会社のルール等でインストールできない場合の方法だったのだが、そのような制約が無ければ普通にフリーウェアを使ったほうが早い。

このAiperEditexというツールがシンプルで動作も高速である。

Excel出力ボタンで検索結果を新規ファイルに出力できる。

[広告]

タイトルとURLをコピーしました