こんにちは！ 健史です。
サクラエディタのGrep検索、システム変更する際の影響範囲、すなわち変更対象プログラムを洗い出す場合などに活用させて頂いています。
検索結果は修正対象プログラムのチェックリストとして、Excelシートに加工編集して使われることもあるでしょう。
検索結果をExcelシートに加工編集するプログラムを作成しました。
処理概要
Grep検索した結果をフォルダに格納
サクラエディタのGrep検索で検索した結果をフォルダに保存します。
サンプルとして下位フォルダを作成し格納しています。実際にはやらないと思いますが。
フォルダ１のファイル[無題2.txt]はの載せていません。
加工編集プログラムの実行
1.シート１に設定シート、シート２とシート３に空白のシートを作成
※プログラムでは、追加を忘れたときのためにシート２とシート３が存在しない場合は、自動で追加するよう対応しました。
1).シート１に以下を貼り付けます。
ドラッグ＆コピー後にExcelに貼り付けるとき、[形式を選択して貼り付ける]-[テキスト]で貼り付けます。(セル[A1]で[右クリック]、[形式を選択して貼り付ける]-[テキスト])を指定します。
設定項目 設定内容 検索フォルダ C:\TEMP06\01.IN 検索レベル M
2.Alt+F8でVBAエディタを開き「2.プログラム」を貼り付け、実行
シート３に編集加工した内容が出力されます。
A列-B列：上記1.で指定したフォルダから読み込んだファイルの情報
C列以降：読み込んだファイルから編集した内容
プログラム
'－－－－－ 変数定義 －－－－－
'定数 cnsFROMは設定シートの検索文字の開始行、設定項目行を追加したら変更
Const cnsDIR = "\*.txt"
'可変変数（一般というか通常の変数）
Dim ix0_1, ix0_1_max, ix0_2, ix0_2_max, ix0_3 As Long
Dim strPath, strFindlvl, strFile, strTxt, strPathname, strFilename, strFindchr, strChr, strType As String
Dim numRow, numColumn As Long
'－－－－－ レベル：０ －－－－－ メイン処理
Sub MAIN00()
'画面遷移を表示させない設定
Application.ScreenUpdating = False
'起動した(この)ファイルのシートからワーク領域へ取り込み
strPath = Sheets(1).Cells(2, 2)
strFindlvl = Sheets(1).Cells(3, 2)
'各シートを初期クリア、見出しセット
Select Case Sheets.Count 'シート２，シート３を追加し忘れた時の対応
Case 1
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "ワーク"
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "リストアップ"
Case 2
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "リストアップ"
End Select
Sheets(2).Cells.Clear
Sheets(3).Cells.Clear
Sheets(3).Cells(1, 1) = "検索フォルダ"
Sheets(3).Cells(1, 2) = "検索ファイル"
Sheets(3).Cells(1, 3) = "検索文字"
Sheets(3).Cells(1, 4) = "フォルダ名"
Sheets(3).Cells(1, 5) = "ファイル名"
Sheets(3).Cells(1, 6) = "文字コード"
Sheets(3).Cells(1, 7) = "開始行"
Sheets(3).Cells(1, 8) = "開始桁"
Sheets(3).Cells(1, 9) = "テキストの内容"
'ワーク領域へ取り込んだ項目のチェック
If Dir(strPath, vbDirectory) = "" Then
MsgBox "対象フォルダがありません！"
Exit Sub
End If
'
Select Case strFindlvl
Case "S", "M"
Case Else
MsgBox "検索レベルが間違っています！"
Exit Sub
End Select
'検索フォルダからファイルの所在情報をシート２に取得
ix0_2 = 0
Call SUB01_DIRLIST(strPath)
ix0_2_max = ix0_2
'検索結果をシート３へセットするため添字に１を設定
ix0_3 = 1
'シート２から取得した検索対象ファイルがなくなるまで繰り返す
For ix0_2 = 1 To ix0_2_max
'検索対象ファイルをオープンすると同時し、変数:excel1へ設定
Open Sheets(2).Cells(ix0_2, 1) For Input As #1
cntLine = 0
Line Input #1, strTxt
Do Until EOF(1) Or Left(strTxt, 5) = "□検索条件"
Line Input #1, strTxt
Loop
pos_st = InStr(1, strTxt, "□検索条件 ")
If pos_st = 0 Then
MsgBox "'□検索条件'が見つからない 、サクラエディタ：Grep検索の結果ですか？" _
& "vbcrlf" & Sheets(2).Cells(ix0_2, 1)
Close #1
End
End If
pos_st = pos_st + 8
pos_end = InStr(pos_st, strTxt, """")
pos_len = pos_end - (pos_st)
strFindchr = Mid(strTxt, pos_st, pos_len)
Do
Line Input #1, strTxt
Loop Until EOF(1) Or strTxt = ""
Do Until EOF(1) Or strTxt <> ""
Line Input #1, strTxt
Loop
Do
Call SUB01_CHUSHUTSU
ix0_3 = ix0_3 + 1
Sheets(3).Cells(ix0_3, 1) = Sheets(2).Cells(ix0_2, 2)
Sheets(3).Cells(ix0_3, 2) = Sheets(2).Cells(ix0_2, 3)
Sheets(3).Cells(ix0_3, 3) = strFindchr
Sheets(3).Cells(ix0_3, 4) = strPathname
Sheets(3).Cells(ix0_3, 5) = strFilename
Sheets(3).Cells(ix0_3, 6) = strType
Sheets(3).Cells(ix0_3, 7) = numRow
Sheets(3).Cells(ix0_3, 8) = numColumn
Sheets(3).Cells(ix0_3, 9) = strChr
Line Input #1, strTxt
Loop Until EOF(1) Or Right(strTxt, 8) = "検出されました。"
Close #1
Next
'上書き保存
ThisWorkbook.Save
Sheets(3).Activate '検索結果であるリストアップシートに位置付ける
MsgBox "処理終了！"
End Sub
Sub SUB01_CHUSHUTSU()
pos_st = InStr(1, strTxt, "]:")
If pos_st = 0 Then
MsgBox "']:'が見つからない！、サクラエディタ：Grep検索の結果ですか？"
Exit Sub
End If
'行文字列を抽出
pos_st1 = pos_st + 3
pos_len = Len(strTxt) + 1 - pos_st1
strChr = Mid(strTxt, pos_st1, pos_len)
'文字列全体を文字反転させて、行文字列を除くディレクトリ～]:までを抽出
pos_len = pos_st + 1
strRev = StrReverse(Left(strTxt, pos_len))
'反転文字列より、ディレクトリ部分からファイル名を抽出
pos_st = InStr(1, strRev, "(") + 1
pos_end = InStr(pos_st, strRev, "\")
pos_len = pos_end - pos_st
strFilename = StrReverse(Mid(strRev, pos_st, pos_len))
'反転文字列長から"("までの長さを引いて、ディレクトリ長さを求める
pos_len_dir = Len(strRev) - InStr(1, strRev, "(")
'反転文字列より、ディレクトリ部分からフォルダパス部分を抽出
pos_len = Len(strRev) - pos_end
strPathname = StrReverse(Mid(strRev, pos_end + 1, pos_len))
'反転文字列より求めたディレクトリ長の先にある","位置を求め、行情報を求める
pos_end = InStr(pos_len_dir + 2, strTxt, ",")
pos_len = pos_end - (pos_len_dir + 2)
numRow = Mid(strTxt, pos_len_dir + 2, pos_len)
'上記の先にある")"位置を求め、開始列情報を求める
pos_st = pos_end + 1
pos_end = InStr(pos_st, strTxt, ")")
pos_len = pos_end - pos_st
numColumn = Mid(strTxt, pos_st, pos_len)
'文字コードタイプを求める
pos_st = InStr(pos_st, strTxt, "[") + 1
pos_end = InStr(pos_st, strTxt, "]")
pos_len = pos_end - pos_st
strType = Mid(strTxt, pos_st, pos_len)
End Sub
'－－－－－ レベル：１ －－－－－
'ディレクトリリスト：シート２に取得
Sub SUB01_DIRLIST(ByVal Path As String)
strFile = Dir(Path & cnsDIR)
Do While strFile <> ""
ix0_2 = ix0_2 + 1
Sheets(2).Cells(ix0_2, 1) = Path & "\" & strFile
Sheets(2).Cells(ix0_2, 2) = Path
Sheets(2).Cells(ix0_2, 3) = strFile
strFile = Dir()
Loop
'検索レベルがシングルのときは、取得終了
Select Case strFindlvl
Case "S"
Exit Sub
End Select
'検索レベルがマルチのとき、サブフォルダまで検索
For Each objFile In CreateObject("Scripting.FileSystemObject").GetFolder(Path).SubFolders
Call SUB01_DIRLIST(objFile.Path)
Next objFile
End Sub
Instr関数を連続で多用し、文字列を抽出しています。
最後に
サクラエディタのGrep検索の結果を加工編集して利用する業務はそうそう発生しないとおもいますが、一度作成しておくことで効率化できます。
編集結果は不要な部分もあると思います。
項目を追加するにはプログラム修正が必要ですが、結果を削除するのは簡単です。
内容にもよりますが、資料作成などでも「追加するよりは削除するほうが簡単」は仕事のポリシーとしています。
「この項目が抜けている」との指摘は、なるべく避けたいですから。
参考にして頂ければと思います。
コメント