ファイルのダウンロードに関しての注意・手順
下記リンクは必ず一読してください
ご了承の上、ファイルのダウンロードをお願いいたします
概要
フォルダ内のファイルすべての文字列をまとめて置換するツール
下記のことができます
- 単純置換
- 置換前文字列を置換後文字列に置換します
- スペース＋改行置換
- 余分なスペースが前に入っているかつ余分な改行を削除します
- スペース分はExcelシートで指定します
- 文字列挿入
- 挿入前の行の文字列を指定し、挿入するスペース＋挿入文字列を挿入前文字列の次の行に追加します
ファイルのダウンロード
手順
- ファイルの置き換えシートの入力
- セルC4に置換したいファイルの入っているフォルダパスを入力
- セルC5にファイルの拡張子（htmlやtxt等）を入力
- 以下は日必要なもののみ9行目から上詰めで入力 （スペースや半角イコールがつく場合は 最初にシングルクオーテーションを入力してから入力）
- 単純置換
- B列に置換前文字列、C列に置換後文字列を入力
- スペース＋改行置換
- E列にスペースをシングルクオーテーションを付けてから入力
- 文字列挿入
- G列の挿入前文字列に直前の行の文字列を指定します
- H列の挿入スペースにどれだけのスペースを入れるかをシングルクオーテーションをつけて指定します
- I列の挿入文字列に挿入したい文字列を指定します
- 実行
- セルB2の実行ボタンを押下します
例
セルの内容
| セル | 値 |
|---|---|
| C4 | フォルダパス（ここでは省略） |
| C5 | .html |
| B9 | |
| C9 | |
| B10 | |
| C10 | |
| B11 | |
| C11 | |
| B12 | |
| C12 | |
| E9 | '____ |
| G9 | |
| H9 | '________ |
| I9 | |
※アンダーバー部分にはスペースが入っています
スペースを見える化するためにアンダーバーを入れました
メインコード
Sub 置換()
'【変数の宣言】
'このファイルとシート
Dim wb As Workbook
Dim ws As Worksheet
'フォルダパスとファイルパス
Dim folderPass As String
Dim filePass As String
'置換
Dim ArrBefore() As String
Dim ArrAfter() As String
'取り除くスペース＋改行部分
Dim ArrSpace() As String
'指定文字列の次の行に文字列を挿入
Dim ArrInBefore() As String
Dim ArrInSpace() As String
Dim ArrInAfter() As String
'判定変数
Dim boolRep As Boolean
Dim boolSpace As Boolean
Dim boolIn As Boolean
'カウンタ変数
Dim i As Long
'カウント
Dim cnt As Long
'拡張子
Dim ex As String
'このファイルとシート
Set wb = ThisWorkbook
Set ws = wb.Sheets("ファイルの書き換え")
'フォルダパスと置換文字列を変数・配列に格納
With ws
'フォルダパス
folderPass = .Range("C4").Value
'拡張子
ex = .Range("C5").Value
'単純置換
i = 9: cnt = 0
If .Range("B" & i).Value <> "" Then
Do While .Range("B" & i) <> ""
ReDim Preserve ArrBefore(cnt)
ReDim Preserve ArrAfter(cnt)
ArrBefore(cnt) = .Range("B" & i).Value
ArrAfter(cnt) = .Range("C" & i).Value
i = i + 1
cnt = cnt + 1
Loop
boolRep = True
Else
ReDim Preserve ArrBefore(0)
ReDim Preserve ArrAfter(0)
ArrBefore(0) = ""
ArrAfter(0) = ""
boolRep = False
End If
'スペース＋改行置換
i = 9: cnt = 0
If .Range("E" & i).Value <> "" Then
Do While .Range("E" & i) <> ""
ReDim Preserve ArrSpace(cnt)
ArrSpace(cnt) = .Range("E" & i).Value
i = i + 1
cnt = cnt + 1
Loop
boolSpace = True
Else
ReDim Preserve ArrSpace(0)
ArrSpace(0) = ""
boolSpace = False
End If
'文字列挿入
i = 9: cnt = 0
If .Range("G" & i).Value <> "" Then
Do While .Range("G" & i) <> ""
ReDim Preserve ArrInBefore(cnt)
ReDim Preserve ArrInSpace(cnt)
ReDim Preserve ArrInAfter(cnt)
ArrInBefore(cnt) = .Range("G" & i).Value
ArrInSpace(cnt) = .Range("H" & i).Value
ArrInAfter(cnt) = .Range("I" & i).Value
i = i + 1
cnt = cnt + 1
Loop
boolSpace = True
Else
ReDim Preserve ArrInBefore(0)
ReDim Preserve ArrInSpace(0)
ReDim Preserve ArrInAfter(0)
ArrInBefore(0) = ""
ArrInSpace(0) = ""
ArrInAfter(0) = ""
boolIn = False
End If
End With
'ファイルパスが存在していなければマクロを終了する
'ファイルパスが存在していればファイル検索プロシージャを呼び出す
filePass = folderPass & "\"
If Len(filePass) = 0 Or Dir(filePass, vbDirectory) = "" Then
MsgBox "完了しました"
Exit Sub
Else
Call ファイル検索_置換(filePass, ex, ArrBefore(), ArrAfter(), _
ArrSpace(), _
ArrInBefore(), ArrInSpace(), ArrInAfter(), _
boolRep, boolSpace, boolIn)
End If
End Sub
置換コード
Sub ファイル検索_置換(filePass As String, ex As String, _
ArrBefore() As String, ArrAfter() As String, _
ArrSpace() As String, _
ArrInBefore() As String, ArrInSpace() As String, ArrInAfter() As String, _
boolRep As Boolean, boolSpace As Boolean, boolIn As Boolean)
Dim aBuf As String
Dim aFile As String
Dim i As Long
filePass = filePass & "\"
aFile = Dir(filePass & "*" & ex)
If aFile = "" Then
Exit Sub
Else
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
Do
.Open
.LoadFromFile filePass & aFile
'テキスト読み込み
aBuf = .ReadText
.Close
'置換前文字列を置換後文字列に変換
'単純置換
If boolRep = True Then
For i = 0 To UBound(ArrBefore)
aBuf = Replace$(aBuf, ArrBefore(i), ArrAfter(i))
Next i
End If
'スペース＋改行置換
If boolSpace = True Then
For i = 0 To UBound(ArrSpace)
aBuf = Replace$(aBuf, vbCrLf & ArrSpace(i) & vbCrLf, vbCrLf)
Next i
End If
'文字列挿入
If boolSpace = True Then
For i = 0 To UBound(ArrInBefore)
aBuf = Replace$(aBuf, ArrInBefore(i) & vbCrLf, ArrInBefore(i) & vbCrLf & ArrInSpace(i) & ArrInAfter(i) & vbCrLf)
Next i
End If
'テキスト書き換え
Call 書き換え(aBuf, filePass & aFile)
aFile = Dir()
Loop Until aFile = ""
End With
aFile = Dir("")
End If
End Sub
テキストの書き換えコード
Sub 書き換え(strText As String, filePass As String)
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
'テキスト書き込み
.WriteText strText
.SaveToFile filePass, 2
.Close
End With
End Sub