Excel VBA からテキスト置換

質問

[ABCDE\X2\058965478965\X0\FGH]
テキストファイル中の上記のような文章から、\X2\と\X0\で囲まれた部分を取り出し、計算した後に置き換えたいのです。
INSTRで検索して、文字列を切り出して、処理するしか方法はないのでしょうか？お教えください。

回答No.1

hana-hana3 · ベストアンサー

下記でいかがでしょうか？
"\"を区切りに配列に取り込んで、数値なら何らかの計算をしています。
厳密な条件がわかりませんので、うまくアレンジして使ってください。

Sub TxtConv()

Dim Ary As Variant
Dim Txt As String
Dim i As Integer

Txt = "ABCDE\X2\058965478965\X0\FGH"

Ary = Split(Txt, "\")
Txt = ""
For i = LBound(Ary) To UBound(Ary)
If Txt <> "" Then Txt = Txt & "\"
If IsNumeric(Ary(i)) Then
Ary(i) = Ary(i) * 100
End If
Txt = Txt & Ary(i)
Next

End Sub

お礼

ありがとうございます。
split関数ですね。参考になりました。

回答No.2

Wendy02

正規表現を使うと便利です。
今回は、大量のデータを考えていませんでしたので、出力は、溜めてから出しましたが、多い場合は、その都度、出力していったほうが安全です。

Option Explicit
Sub TextRelace()
　Dim MyPath
　Dim MyInFile As String
　Dim MyOutFile As String
　Dim lngCount As Long
　Dim textLine As String
　Dim objRe As Object
　Dim Fno As Integer
　Dim myDataLen As Integer
　Dim myData As String, myNewData As String
　Dim NewTextLines As String
　Dim Matches As Object, Match As Variant
　Dim buf As String
　Dim Ret As Variant
　'
　'ユーザー設定
　'===================================
　MyPath = ThisWorkbook.Path & "\" 'パス名
　MyInFile = "test01.txt"　'入力ファイル
　MyOutFile = "test02.txt"　'出力ファイル
　'===================================
　'
　If Dir(MyPath & MyInFile) = "" Then MsgBox "ファイルがありません", 16 _
　: Exit Sub
　Fno = FreeFile
　Set objRe = CreateObject("VBScript.RegExp")
　With objRe
　　.Pattern = "\\X2\\(\d+)\\X0\\"　'正規表現パターン
　　.Global = True '同一ライン上で、複数の置換可能
　　Open MyInFile For Input As #Fno
　　Do While Not EOF(1)
　　　Line Input #Fno, textLine
　　　If .test(textLine) Then
　　　　buf = textLine
　　　　Set Matches = .Execute(buf)
　　　　For Each Match In Matches
　　　　　myData = .Replace(Match, "$1")
　　　　　'計算例
　　　　　'===================================
　　　　　Ret = CDbl(myData) / 2
　　　　　myDataLen = Len(Ret)
　　　　　myNewData = Format$(Ret, String(myDataLen, "0"))
　　　　　'文字列で戻すなら、どのような方法でも可能
　　　　　'===================================
　　　　　buf = Replace(buf, myData, myNewData)
　　　　Next Match
　　　　NewTextLines = NewTextLines & buf & vbCr
　　　End If
　　Loop
　　Close #Fno
'
'出力
　　Fno = FreeFile
　　Open MyOutFile For Output As #Fno
　　Print #Fno, NewTextLines
　　Close #Fno
　End With
　Set objRe = Nothing
End Sub

お礼

参考にしようと思いましたが、私には少し敷居が高く、うまくカスタマイズできませんでした。
今回は同じ行にたくさん\X2\とかのフラグがあって、それぞれを抜き出す必要がありましたので、No.1の方のsplitで配列に抜き出してセルへ振り分け、計算後戻すというやりかたがうまくいきました。
ありがとうございます。