複数設計書を管理するためのExcel file内の文字列検索

2024/09/03

なぜ作成しようと考えたのか！

こんにちは！🈸です。

初めての投稿で緊張しています。。。
皆さんの参考になるのかどうか、
あくまで一エンジニアとしてのアイディアとしてご覧いただければ幸いです！

～背景～
皆さんは業務での設計書は何で管理されていますか？
私が参画した現場はエクセルで作成されていました。

今回対応するタスクで影響が必要になり、設計書を1つ1つ確認して、

当たりをつけた上で実装を確認する流れになりました。
（Grep検索では利用している変数が人によってまちまちで追いきれない）　

山ほどある設計書を1ファイルずつ確認する。。。。
無理！！

じゃあ、簡単なツール作って検索すればいいじゃんってなり、

作成することにしました。

検索ツール♪

H2：検索ワードを入力

H3：検索対象フォルダを指定
上記を入力し、検索ボタンを押すと、対象フォルダ内のエクセルファイルを開き、1つ1つ検索ワードをサーチしてくれて、検索結果を新規シート作成して、そこに列挙してもらう仕組みです。

■マクロ

Sub 検索開始()
Dim searchString As String
Dim folderPath As String

' 検索シートから検索文字列とフォルダパスを取得
searchString = ThisWorkbook.Sheets("検索").Range("H2").Value
folderPath = ThisWorkbook.Sheets("検索").Range("H3").Value

If folderPath = "" Or searchString = "" Then
MsgBox "検索する文字列とフォルダパスを入力してください。"
Exit Sub
End If

' 検索結果シートが存在する場合は削除
Dim resultSheet As Worksheet
On Error Resume Next
Set resultSheet = ThisWorkbook.Sheets("検索結果")
On Error GoTo 0

If Not resultSheet Is Nothing Then
Application.DisplayAlerts = False
resultSheet.Delete
Application.DisplayAlerts = True
End If

' 検索結果シートを新規作成
Set resultSheet = ThisWorkbook.Sheets.Add
resultSheet.Name = "検索結果"
resultSheet.Range("B1:G1").Value = Array("検索ワード", "ファイルパス", "ファイル名", "シート名", "セル番号", "セルの値")

' フォルダ内の全てのExcelファイルを検索
Dim rowNum As Long
rowNum = 2
SearchFilesInFolder folderPath, searchString, resultSheet, rowNum
MsgBox "検索が完了しました。"
End Sub

Sub SearchFilesInFolder(folderPath As String, searchString As String, resultSheet As Worksheet, ByRef rowNum As Long)
Dim fso As Object
Dim folder As Object
Dim subfolder As Object
Dim file As Object
Dim wb As Workbook

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderPath)

' フォルダ内の全てのファイルをチェック
For Each file In folder.Files
If LCase(fso.GetExtensionName(file.Name)) = "xlsx" Or LCase(fso.GetExtensionName(file.Name)) = "xls" Then
Set wb = Workbooks.Open(file.Path)
SearchStringInWorkbook wb, searchString, resultSheet, rowNum, file.Path, file.Name
wb.Close SaveChanges:=False
End If
Next file

' サブフォルダ内の全てのファイルを再帰的にチェック
For Each subfolder In folder.Subfolders
SearchFilesInFolder subfolder.Path, searchString, resultSheet, rowNum
Next subfolder
End Sub

Sub SearchStringInWorkbook(wb As Workbook, searchString As String, resultSheet As Worksheet, ByRef rowNum As Long, filePath As String, fileName As String)
Dim ws As Worksheet
Dim cell As Range
Dim firstAddress As String

' 各シートをループ
For Each ws In wb.Worksheets
' 各シートで文字列を検索
With ws.Cells
Set cell = .Find(What:=searchString, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not cell Is Nothing Then
firstAddress = cell.Address
Do
' 検索結果を結果シートに書き込み
resultSheet.Cells(rowNum, 2).Value = searchString
resultSheet.Cells(rowNum, 3).Value = filePath
resultSheet.Cells(rowNum, 4).Value = fileName
resultSheet.Cells(rowNum, 5).Value = ws.Name
resultSheet.Cells(rowNum, 6).Value = cell.Address
resultSheet.Cells(rowNum, 7).Value = cell.Value
rowNum = rowNum + 1
Set cell = .FindNext(cell)
Loop While Not cell Is Nothing And cell.Address <> firstAddress
End If
End With
Next ws
End Sub