文字操作 指定ファイル内の指定文字を検索し置換える

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


'ファイル内文字置換 ThisWorkbook.Path & "\参照雛形\index.txt", "vbサムネイル", "vbサムネイル"

Sub ファイル内文字置換(対象ファイル$, 検索字$, 置換字$)
'***************************************************
'指定ファイル内の指定文字を検索し置換える
'***************************************************
Dim RetrievalCharacter$, ConversionCharacter$
Dim OriginalFile$, ReproductionFile$
Dim WritingFile As Integer, ReadingFile As Integer
Dim strDAT$, lngCnt&

'パラメータ設定部----------------------------------------------------
'元のファイルフルパスとファイル名
OriginalFile = 対象ファイル
'コピーするファイルとファイル名
ReproductionFile = ThisWorkbook.Path & "\Copy" & Format(Date, "yymmdd") & Format(Time, "hhmmss") & ".txt"
'検索文字
RetrievalCharacter = 検索字
'置換文字
ConversionCharacter = 置換字
'--------------------------------------------------------------------

'エラーが発生した場合次のステートメントから実行継続
On Error Resume Next

'ファイルコピーの実行
FileCopy OriginalFile, ReproductionFile

'エラーが発生した場合
If Err <> 0 Then
    MsgBox "Error" & Err, vbCritical, "Error"
    Exit Sub
End If

'元のファイル削除
Kill OriginalFile

'使用可能なファイル番号取得
WritingFile = FreeFile()
Open ReproductionFile For Input As #WritingFile

'使用可能なファイル番号取得
ReadingFile = FreeFile()
Open OriginalFile For Output As #ReadingFile

'変数初期化
lngCnt = 0
'グローバル変数の初期化
lngNo = 0

Do Until EOF(WritingFile) '最後(全て)
    'ファイル読込
    Line Input #WritingFile, strDAT
    '置換実行(Function)---------------↓対象文字列------↓検索文字------↓置換文字
    lngCnt = lngCnt + FncstrReplace(strDAT, RetrievalCharacter, ConversionCharacter)
    'ファイルに挿入
    Print #ReadingFile, strDAT
Loop

'それぞれのファイルを閉じる
Close #WritingFile
Close #ReadingFile

'最初にコピーしたファイルを削除
Kill ReproductionFile

End Sub


Private Function FncstrReplace&(ByRef 対象文字列$, 検索文字$, 置換文字$)
'***********************************************************************
'指定文字列内の指定文字を検索し置換える
'***********************************************************************

Dim RetrievalResultPosition&, RetrievalBeginningNumber&
Dim ReplacementCharacterNumber&, ConversionCharacterNumber&

    '重複防止検索開始番号初期化
    RetrievalBeginningNumber = 1

    'パラメータ設定
        '置換え側[+ 3]は付ける番号の文字数又は桁数)
        ReplacementCharacterNumber = Len(置換文字) + 3
        '検索側
        ConversionCharacterNumber = Len(検索文字)

    Do
        '対象文字列の検索文字位置取得
        RetrievalResultPosition = InStr(RetrievalBeginningNumber, 対象文字列, 検索文字, vbBinaryCompare)
        '検索文字が[0]の場合
        If RetrievalResultPosition = 0 Then Exit Do

        FncstrReplace = FncstrReplace + 1

        '置換
        対象文字列 = Left$(対象文字列, RetrievalResultPosition - 1) & 置換文字 _
          & Right$(対象文字列, Len(対象文字列) - RetrievalResultPosition - ConversionCharacterNumber + 1)

        '重複検索を防止
        RetrievalBeginningNumber = RetrievalResultPosition + ReplacementCharacterNumber
    Loop

End Function


 

 

 

2000年01月01日|[VBサンプルコード]:[文字操作]