質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

3回答

824閲覧

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

HuransowaRuiz

総合スコア14

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2021/05/18 12:28

Sub sample()

'変換表はこのブックの1シート目に用意されているものとする 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
など
これらを部分一致ではなく完全一致で置換する方法はないでしょうか

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

hatena19

2021/05/19 00:50

> Aの内容に部分一致があった場合、置換内容が間違ってしまいます。 これの具体例(buf、A1、B1 の値と、間違った置換結果、希望の置換結果 )をいくつか挙げてもらえませんか。
guest

回答3

0

ベストアンサー

VBA

1Dim buf, arr, i 2buf = ADOFileLoad(ThisWorkbook.Path & "\" & Filename) 3arr = Split(buf, vbNewLine) 4 5'変換表に従い置換 6Dim c As Range 7For Each c In Rng.Cells 8 For i = 0 To UBound(arr) 9 If arr(i) = c.Value Then arr(i) = c.Offset(, 1).Value 10 DoEvents 11 Next 12Next 13buf = Join(arr, vbNewLine) 14'別名でtxt書き出し 15ADOFileSave buf, ThisWorkbook.Path & "\New_" & fileName

投稿2021/05/19 09:06

jinoji

総合スコア4585

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

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

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

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

vba

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

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

投稿2021/05/19 01:29

hatena19

総合スコア33620

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

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

VBA

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

投稿2021/05/18 23:20

Usirow

総合スコア364

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問