置換元が複数ある場合の部分一致をどうすればいいか

Question

Sub sample()

'変換表はこのブックの１シート目に用意されているものとする
Dim mySheet As Worksheet, rng As Range
Set mySheet = ThisWorkbook.Worksheets(1)
Set rng = mySheet.UsedRange.Columns(1)


'txtファイルはこのマクロと同じ場所にあるものとする
Dim fileName As String
fileName = Dir(ThisWorkbook.Path & "*.txt")


'ループ
Do While fileName <> ""

    '読み込み（ファイルはすべてUTF-8であるものとする）
    Dim buf, arr
    buf = ADOFileLoad(ThisWorkbook.Path & "\" & fileName)

    '変換表に従い置換
    Dim c As Range
    For Each c In rng.Cells
        buf = Replace(buf, c.Value, c.Offset(, 1).Value)
        DoEvents
    Next
    '別名でtxt書き出し
    ADOFileSave buf, ThisWorkbook.Path & "\New_" & fileName

    'シートにも書き出し
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets.Add(After:=mySheet)

    arr = Split(buf, vbNewLine)
    ws.Cells.Resize(UBound(arr) + 1, 1).Value = WorksheetFunction.Transpose(arr)

    '次へ
    fileName = Dir()
Loop

End Sub

Function ADOFileLoad(myPath)

With CreateObject("ADODB.Stream")
    .Open
    .Type = 2
    .Charset = "UTF-8"
    .LoadFromFile myPath
    ADOFileLoad = .ReadText
    .Close
End With

End Function

Sub ADOFileSave(buf, myPath)

With CreateObject("ADODB.Stream")
    .Open
    .Type = 2
    .Charset = "UTF-8"
    .WriteText buf
    .SaveToFile myPath, 2
    .Close
End With

End Sub

の形でファイルのAをBに置換しているのですが、
Aの内容に部分一致があった場合、置換内容が間違ってしまいます。
例:セルA1:setenv MUSUU00100とB1:set MUSUU0010W
セルA1:setenv MUSUU0010とB1:setenv MUSUU0010W
など
これらを部分一致ではなく完全一致で置換する方法はないでしょうか

Comments

[hatena19]

> Aの内容に部分一致があった場合、置換内容が間違ってしまいます。

これの具体例(buf、A1、B1 の値と、間違った置換結果、希望の置換結果 )をいくつか挙げてもらえませんか。

Answer 1

Dim buf, arr, i
buf = ADOFileLoad(ThisWorkbook.Path & "\" & Filename)
arr = Split(buf, vbNewLine)

'変換表に従い置換
Dim c As Range
For Each c In Rng.Cells
    For i = 0 To UBound(arr)
        If arr(i) = c.Value Then arr(i) = c.Offset(, 1).Value
        DoEvents
    Next
Next
buf = Join(arr, vbNewLine)
'別名でtxt書き出し
ADOFileSave buf, ThisWorkbook.Path & "\New_" & fileName

Answer 2

テキスト、変換表 の内容が不明瞭なので、確認はできませんが、とりあえず下記のようにすればどうでしょうか。

変換表のC1セルに下記の式を設定。
=LEN(A1)
表の最後の行までフィルダウン
C列で降順に並び替え

上記の設定をしておいたうえで、

    '変換表に従い置換
    Dim c As Range
    For Each c In rng.Cells
        If Not buf Like "*" & c.Offset(, 1).Value & "*"
        buf = Replace(buf, c.Value, c.Offset(, 1).Value)
    Next

上記でうまくいかない場合は、その時の buf, c.Value, c.Offset(, 1).Value の値を提示してください。

Answer 3

素直にIf文で判定するのが一番簡単だと思います。

If buf = c.value Then
    buf = Replace(buf, c.Value, c.Offset(, 1).Value)
End If