VBA テンプレート　ExcelGrep検索＆置換ツール

## 概要
自分用です。
以前投稿したExcelgrep検索・置換ツールをさらにパワーアップさせました。
・検索＆置換のオプションとして完全一致or部分一致や大文字or小文字などが設定できます。
・また、ファイル検索機能も追加しました。ファイルは複数選択可能です。
※フィルターの解除機能とブックの読み取り専用リンク更新なし機能を追加しました。(2023/10/4)

## 実施方法の説明

1. A列に検索したい文字列を書きます。複数行設定可能です。
2. 文字列を置換したい場合はB列に置換した後の単語を書きます。A列の同じ行の単語が置換されます。
3. E列に検索対象のファイルのフルパスを書きます。「ファイル名検索」ボタンでファイルパスを追加することもできます。※VBA：Sub ファイル検索()
4. 「オプション」シートで検索条件をB列に設定します。
5. 検索したい場合は「検索」ボタンを押下します。※VBA：Sub 検索()
	検索完了後、F列に検索結果が出力されます。ヒットした単語のみ「シート名：セル内の文字列」で出力されます。
6. 置換したい場合は「置換」ボタンを押下します。※VBA：Sub 置換()
	「置換したい場合『はい』を選択してください」とポップアップが出るので「はい」を押下してください。
	置換完了後、G列に検索結果が出力されます。ヒットした単語のみ「シート名：置換後のセル内の文字列」で出力されます。

* 注意
  * マクロの処理が重い場合、Excelが落ちる可能性があります。ほかに開いているファイルがあれば処理の前に保存しておくことをおすすめします。
  * E列の中にファイル検索不要の行がある場合、D列に「×」を記載すると検索処理がスキップされます。


## シートの作成
Excelシートは2シートです。
「ファイル一覧」シート
「オプション」シート

★「ファイル一覧」シートを作成

「ファイル一覧」シートに表は２つ作成します。
表は５列目にタイトル
６列目以降に値が入ります

表1　検索文字列と置換文字列一覧
A列：検索したい文字列一覧
B列：置換したい文字列一覧(A列に対応)

表2　操作ファイルとその結果
D列：操作の要否（操作不要なら×を記載）
E列：操作したいファイルのフルパス
F列：検索結果(セルのアドレスと値)
G列：置換結果(置換したセルのアドレスと置換後のセルの値)

「ファイル一覧」シート画像
![VBAgrep 2022-07-04 221014.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/2550991/c1df90cd-611e-b1f1-6656-abca3e178ec6.png)

★「オプション」シートを作成

「オプション」シートに表は２つ作成します。
表は4列目にタイトル
5列目以降に値が入ります
※現在設定項目は４つ、順序も値も完全一致しない場合デフォルトの値が設定されます。

表1　
A列：設定項目
B列：設定値←この列の値が集計されます。

表2　設定値候補
処理には関係ありませんが、設定値をわかりやすくするために作成します。
図「オプション」シートを参照してください
この図のD列の値がデフォルトとして設定されています。


図「オプション」シート
![VBAオプション 2022-07-04 220729.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/2550991/a053a01e-9799-a32b-ed56-967462deda33.png)



## VBAコード
Moduleは5つ作成します。

Module1
検索ボタンと置換ボタン
※置換は置換して問題ないか確認画面が出ます

```
Sub 検索()

    OpenFile ("検索")

End Sub

Sub 置換()

    ans = MsgBox("置換したい場合『はい』を選択してください", vbYesNo)
    
    If ans = vbYes Then
    
        OpenFile ("置換")
        
    End If
End Sub

```

Module2
ファイル検索
```
Sub ファイル検索()

Dim ファイル一覧シート As Variant
Set ファイル一覧シート = ThisWorkbook.Sheets("ファイル一覧")

    Dim 選択ファイル As Variant
    Dim f As Variant
    
    ChDir "C:"
    選択ファイル = Application.GetOpenFilename( _
         FileFilter:="Excel ファイル (*.xls; *.xlsx),*.xls; *.xlsx", _
         MultiSelect:=True)
         
Dim filei As Integer
    
    If IsArray(選択ファイル) Then
        filei = ファイル一覧シート.Range("E10000").End(xlUp).Row + 1
        For Each ファイル In 選択ファイル
            ファイル一覧シート.Range("E" & filei) = ファイル
            filei = filei + 1
        Next
    End If


End Sub

```


Module3
ファイルを開く

```
Function OpenFile(ByRef 操作種別 As String)

Application.ScreenUpdating = False
Dim mySheet As Variant
Set mySheet = ThisWorkbook.Sheets("ファイル一覧")
Dim 操作ブック As Workbook
Dim 結果 As String

'共通の値の設定
Dim 列 As String
If 操作種別 = "検索" Then
    列 = "F"
ElseIf 操作種別 = "置換" Then
    列 = "G"
End If


On Error GoTo ファイルエラー

'E列に記載されたファイルを開いていく
For file_i = 6 To mySheet.Range("E10000").End(xlUp).Row
    
    結果 = "" '初期化
    mySheet.Range(列 & file_i).Value = "検索出来ず"
    
     '検索不要の場合処理を飛ばす
     If mySheet.Range("D" & file_i).Value = "×" Then
        GoTo skip
     End If
     
       '置換-------------------------------------
       If 操作種別 = "置換" Then
           Set 操作ブック = Workbooks.Open(mySheet.Range("E" & file_i))   '書き込み用に開く
           
           For Each 置換対象シート In 操作ブック.Worksheets
           
                'シートのフィルターをすべて解除する
                If 置換対象シート.AutoFilterMode Then
                    置換対象シート.ShowAllData
                End If
           
               結果 = 結果 & ファイル検索置換操作(置換対象シート, 操作種別) '処理の実行
               
           
           Next '置換対象シート
           
           操作ブック.Close SaveChanges:=True  '保存する
           
       ElseIf 操作種別 = "検索" Then
       '検索-------------------------------------
           Set 操作ブック = Workbooks.Open(mySheet.Range("E" & file_i), UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)   '読み取り専用に開く
           
           For Each 検索対象シート In 操作ブック.Worksheets
           
               If 検索対象シート.AutoFilterMode Then  'フィルターを削除する
                   検索対象シート.AutoFilterMode = False
               End If
           
               結果 = 結果 & ファイル検索置換操作(検索対象シート, 操作種別) '処理の実行
           
           Next '検索対象シート
           
           操作ブック.Close SaveChanges:=False  '保存しない
       End If
       
       If Len(結果) = 0 Then
           結果 = "検索結果0件"
       End If
    
       mySheet.Range(列 & file_i).Value = 結果
       
     GoTo skip

ファイルエラー:
   
    mySheet.Range(列 & file_i).Value = "ファイル開かず"
skip:
Next 'file_i


End Function




```


Module4
検索文字の選択

```
Function ファイル検索置換操作(ByVal 対象シート As Worksheet, ByRef 操作種別 As String) As String

On Error GoTo エラー

Dim mySheet As Variant
Set mySheet = ThisWorkbook.Sheets("ファイル一覧")

Dim 結果 As String
結果 = ""

Dim 対象セル As Range, tempRng As Range

    '検索対象の文字列のループを開始する
    For i = 6 To mySheet.Range("A10000").End(xlUp).Row
    
        '空白のセルを検索してしまった場合無限ループになるので飛ばす
        If mySheet.Range("A" & i) = "" Then
            GoTo continue
        End If
        
        結果 = 結果 & 検索置換_オプション設定(対象シート, mySheet.Range("A" & i), _
        mySheet.Range("B" & i), 操作種別)

continue:
    Next i


ファイル検索置換操作 = 結果
Exit Function

エラー:
ファイル検索置換操作 = "エラー発生"




End Function



```


Module5
オプションの設定と検索置換操作

```
Function 検索置換_オプション設定(ByRef 対象シート As Worksheet, ByRef 検索文字 As String, ByRef 置換文字 As String, ByRef 操作種別 As String) As String

On Error GoTo エラー


'検索オプションの設定
Dim オプションシート As Variant
Set オプションシート = ThisWorkbook.Sheets("オプション")

'一致範囲の設定
Dim 完全一致 As Variant
If オプションシート.Range("B5") = "完全一致" Then
    完全一致 = 1    'xlWhole 1   検索テキスト全体を検索します。
Else
    完全一致 = 2    'xlPart 2   検索テキストの一部を検索します。
End If


'大文字・小文字の区別の設定
Dim 大小文字 As Variant
If オプションシート.Range("B6") = True Then
    大小文字 = True
Else
    大小文字 = False
End If

'半角・全角区別の設定
Dim 半全角 As Variant
If オプションシート.Range("B7") = True Then
    半全角 = True
Else
    半全角 = False

End If

'書式一致の設定
Dim 書式一致 As Variant
If オプションシート.Range("B8") = True Then
    書式一致 = True
Else
    書式一致 = False
End If

'検索の対象の設定
Dim 検索の対象 As Variant
If オプションシート.Range("B8") = "数式" Then

    検索の対象 = -4123 'xlFormulas  -4123   数式
ElseIf オプションシート.Range("B8") = "コメント" Then
    検索の対象 = -4144 'xlComments  -4144   コメント
Else
    検索の対象 = -4163 'xlValues    -4163   値
    
End If



''''検索の実施
Dim 結果 As String
結果 = ""

Dim 検索結果セル As Range


Set 検索結果セル = 対象シート.Cells.Find(検索文字, _
SearchOrder:=xlByRows, _
LookAt:=完全一致, _
MatchCase:=大小文字, _
MatchByte:=半全角, _
SearchFormat:=書式一致, _
LookIn:=検索の対象)


'2つ目以降の検索

Dim 対象セル As Range, tempRng As Range

    ' 2個以上の場合に備え、検索結果を一時保存
    Set tempRng = 検索結果セル
    ' 条件にあったセルが見つからなければNothingでループを抜ける
    Do While Not 検索結果セル Is Nothing
        
        If 操作種別 = "置換" Then
            検索結果セル.Value = Replace(検索結果セル.Value, 検索文字, 置換文字)
        End If
        
        結果 = 結果 & 対象シート.Name & 検索結果セル.Address & " : " & 検索結果セル & vbCrLf
        
        ' FindNextで検索を継続
        Set 検索結果セル = 対象シート.Cells.FindNext(検索結果セル)
        '検索結果セル＝Nothingでエラーが発生するためここで対処
        If 検索結果セル Is Nothing Then
            Exit Do
        End If
        ' これを忘れると無限ループになるので注意！
        If 検索結果セル.Address = tempRng.Address Then
            Exit Do
        End If
    Loop

検索置換_オプション設定 = 結果

Exit Function

エラー:
ファイル検索操作 = "エラー発生"

End Function


```