特定のパターンの文字列の間に何もない場合にダミー文字列を挿入

特定のパターンの文字列の間に何もない場合にダミー文字列を挿入

こんにちは、VBA初心者です。

以下のような処理をVBAで行いたいのですが、かなり基本的なところでつまずいています。
（この場合、テキストファイルを開くのにOpenステートメント使うべきかFSOでいくべきか、というあたりで既につまずいています）どのような手法で進めていったらいいのかアドバイスをいただけないでしょうか。

1. 下に示す「テキストサンプル」のような内容のテキストファイルがあるとします。

2. このファイル内の「:SAMPLE_TEXT_ID_」で始まる行と行の間に何もなかった場合は、任意のダミー文字（「Dummy」など）を挿入します。

2.2. 「//」で始まる行はコメントなので無視します（空行と同じとみなす）。あるいは、ダミー文字を挿入する処理を実行する前に削除してしまいます。

※以下の「テキストサンプル」では「:SAMPLE_TEXT_ID_ABC_002」と「:SAMPLE_TEXT_ID_AAA_001」の間に「Dummy」が挿入されれば成功です。

3. 上記の処理をフォルダ内のすべてのテキストファイルに対して実行します（100ファイル以上あります）。

【テキストサンプル】
:SAMPLE_TEXT_ID_ABC_001
Sample text

:SAMPLE_TEXT_ID_AABBCC_001
//Sample comment
Test string

:SAMPLE_TEXT_ID_ABC_002

:SAMPLE_TEXT_ID_AAA_001
Temp text: any text in the file

とりあえず、1つのファイルを開く所だけ自分で書いてみましたが、なぜかファイルの最終行のみが連続して書き出されてしまいました。（フォルダ内のある100以上のファイルをすべて処理することを考えると、やっぱりワークシートに書き出さないほうがいいような気がするのですが、それではどうすればいいのか言われると？？？です）

Sub ダミー文字挿入()
Dim myImput As String
Dim i As Integer

Open "D:\VBA\sample_01.txt" For Input As #1
i = 1

Do Until EOF(1)
Input #1, myImput

For i = 1 To 3
Cells(i, 1).Value = myImput
Next i
Loop
End Sub
【サンプルコード】

No.3 ベストアンサー 回答者： nda23 回答日時： 2010/10/14 22:32

３要素しかないのだから、億劫がらずに理論展開しましょうよ。

(1)
最初の有効数の値は-1なので、If 有効数 > 1 にはかからず、
Else節が実行されます。有効数は１が加えられ0になります。
次のLine Input #1, バッファ(有効数)はバッファ(0)ですね。
(2)
２回目は有効数が0なので、やはりIf文のElse節に入り、
有効数は1になります。次の読み込みはバッファ(1)に読み込まれ
ます。
(3)
３回目は有効数が1なので、やはりIf文のElse節に入り、
有効数は2になります。次の読み込みはバッファ(2)に読み込まれ
ます。
(4)
つまり有効数>1とは３行読み込んでいるという状態を示すのです。
よって、Line Input 後のIfで、３行を比較し、各行の条件を
調べているのです。
(5)
ループの４回目は最初のIf文では初めてThen節に入ります。
そこで、一番古いバッファ(0)を出力し、バッファの要素を
前方に移動します。つまり、(0)←(1)、(1)←(2)という具合です。
Then節では有効数が+1されないので、有効数は2のままです。
(6)
ということで、3行目以降は常にバッファ(2)に読み込まれます。
勿論、ループ１回に１行ずつしか読み込んでいません。

初心のうちから横着すると、論理的思考能力が鍛錬されませんよ。
もし、怪しいなら、デバッグ実行で、１ステップずつ実行して動作を
確認するぐらいのことはやらないといけません。
尚、掲題のコードは実際に実行させていますので、実行時エラーが
出るとすると、コピーミス（&の前の空白をぬいてしまうとか）では
ないかと思います。

この回答へのお礼

お礼が遅くなり大変申し訳ありません。

プログラミングにもだいぶ慣れてきて、ご提案の手法もかなり理解できるようになっていきました。
まだまだ初歩的な質問をせざるを得ないレベルですが、このようなサイトなどを利用しながら勉強していきたいと思っています。

今後また質問した時にはよろしくお願いいたします。

お礼日時：2010/10/26 08:54

No.2 回答者： nda23 回答日時： 2010/10/13 17:48

スミマセン

間違いが２箇所あります。

Const 元パス As String = "C:\VBA\"
Const 新パス As String = "C:\TMP\"
Const 固定語 As String = ":SAMPLE_TEXT_ID_" '☆追加
Dim ファイル名 As String
Dim 位置 As Long
Dim 有効数 As Long
Dim シェル, 旧フォルダ, 新フォルダ

ファイル名 = Dir(元パス & "*.txt")
Do Until ファイル名 = ""
　　　　Open 元パス & ファイル名 For Input As #1
　　　　Open 新パス & ファイル名 For Output As #2
　　　　有効数 = -1
　　　　ReDim バッファ(2) As String
　　　　Do Until EOF(1)
　　　　　　　　If 有効数 > 1 Then
　　　　　　　　　　　　Print #2, バッファ(0)
　　　　　　　　　　　　バッファ(0) = バッファ(1)
　　　　　　　　　　　　バッファ(1) = バッファ(2)
　　　　　　　　Else
　　　　　　　　　　　　有効数 = 有効数 + 1
　　　　　　　　End If
　　　　　　　　Line Input #1, バッファ(有効数)
　　　　　　　　If 有効数 > 1 Then
　　　　　　　　　　　　If Left(バッファ(0), 16) = 固定語 And _
　　　　　　　　　　　　　　バッファ(1) = "" And _
　　　　　　　　　　　　　　Left(バッファ(2), 16) = 固定語 Then
　　　　　　　　　　　　　　　　バッファ(1) = "Dummy"
　　　　　　　　　　　　End If
　　　　　　　　End If
　　　　Loop
　　　　Close #1
　　　　For 位置 = 0 To 有効数
　　　　　　　　Print #2, バッファ(位置)
　　　　Next
　　　　Close #2
　　　　ファイル名 = Dir '★1
Loop
Set シェル = CreateObject("Shell.Application")
set 旧フォルダ = シェル.NameSpace(元パス)
set 新フォルダ = シェル.NameSpace(新パス)
旧フォルダ.MoveHere 新フォルダ.Items, &H10 '★2

【解説】
(1)
ファイル名 = Dir(元パス & "*.txt")
Do Until ファイル名 = ""
Dir関数は指定パターンに一致するファイル名を返します。
なければ空文字列が返るので、次のDo文と合わせて、
フォルダ内の指定パターンのファイルを全て処理します。
★1の「次のファイル名を受け取る」というステートメントを
忘れたため、無限ループになってしまいました。
(2)
有効数 = -1
ReDim バッファ(2) As String
指定パターンであることを認識するには３行読み込んで
調べる必要があるため、３要素の配列を定義しています。
インデックスの底は0なので、有効数が-1とは全ての要素が
無効であるという意味です。
(3)
If 有効数 > 1 Then
　　Print #2, バッファ(0)
　　バッファ(0) = バッファ(1)
　　バッファ(1) = バッファ(2)
Else
　　有効数 = 有効数 + 1
End If
Line Input #1, バッファ(有効数)
有効数が２（つまり配列が一杯）なら、最初の行を書き込み、
配列を詰め替えます。そうでなければ読み込み先となる
インデックスを更新しています。
(4)
If 有効数 > 1 Then
　　If Left(バッファ(0), 16) = 固定語 And _
　　　　バッファ(1) = "" And _
　　　　Left(バッファ(2), 16) = 固定語 Then
　　　　　　バッファ(1) = "Dummy"
　　End If
End If
３行読み込まれていたら、パターンに一致するかを調べて、
一致すれば中間行に"Dummy"を入れています。
(5)
For 位置 = 0 To 有効数
　　Print #2, バッファ(位置)
Next
配列の残りを出力しています。
(6)
Set シェル = CreateObject("Shell.Application")
== 中略 ==
旧フォルダ.MoveHere 新フォルダ.Items, &H10
新フォルダ内のファイルを全て元フォルダに上書き移動
します。&H10は何も聞かないという意味です。

この回答へのお礼

懇切丁寧にご説明いただき、本当にありがとうございます。

実行すると「定数式が必要です。」となってしまいますが、だいたい処理の内容が理解できました。

でも、バッファの概念がイマイチ理解できないのですが、

Line Input #1, バッファ(有効数)

とすると、有効数が2の場合、配列に3行分格納してくれるということでしょうか。

私のような初心者だと、ここは「Do Until EOF(1)」の中なので、1行ずつしか読み込まれないのではないか（バッファ(0)しか格納されないのではないか）と思ってしまいます。

やっぱり、理解できていないのでしょうね。
今後、勉強していくうちにわかるようになったらいいなと思います。

お礼日時：2010/10/14 16:37

No.1 回答者： nda23 回答日時： 2010/10/12 09:49

先ず、テキストファイルは入力/出力/追加のいずれかの

モードでしか開けませんので、この問題を解決するには
旧ファイルを読み込み、新ファイルにコピーしながら、
問題の部分だけ、特別な書き込みを行うようにします。
新しいファイルを作る場所を"D\TMP"と仮定します。

Const 元パス As String = "C:\VBA\"
Const 新パス As String = "C:\TMP\"
Dim ファイル名 As String
Dim 位置 As Long
Dim 有効数 As Long
Dim シェル, 旧フォルダ, 新フォルダ

ファイル名 = Dir(元パス & "*.txt")
Do Until ファイル名 = ""
　　　　Open 元パス & ファイル名 For Input As #1
　　　　Open 新パス & ファイル名 For Output As #2
　　　　有効数 = -1
　　　　ReDim バッファ(2) As String
　　　　Do Until EOF(1)
　　　　　　　　If 有効数 > 1 Then
　　　　　　　　　　　　Print #2, バッファ(0)
　　　　　　　　　　　　バッファ(0) = バッファ(1)
　　　　　　　　　　　　バッファ(1) = バッファ(2)
　　　　　　　　Else
　　　　　　　　　　　　有効数 = 有効数 + 1
　　　　　　　　End If
　　　　　　　　Line Input #1, バッファ(有効数)
　　　　　　　　If 有効数 > 1 Then
　　　　　　　　　　　　If Left(バッファ(0), 16) = ":SAMPLE_TEXT_ID_" And _
　　　　　　　　　　　　　　バッファ(1) = "" And _
　　　　　　　　　　　　　　Left(バッファ(2), 16) = ":SAMPLE_TEXT_ID_" Then
　　　　　　　　　　　　　　　　バッファ(1) = "Dummy"
　　　　　　　　　　　　End If
　　　　　　　　End If
　　　　Loop
　　　　Close #1
　　　　For 位置 = 0 To 有効数
　　　　　　　　Print #2, バッファ(位置)
　　　　Next
　　　　Close #2
Loop
Set シェル = CreateObject("Shell.Application")
set 旧フォルダ = シェル.NameSpace(元パス)
set 新フォルダ = シェル.NameSpace(新パス)
旧フォルダ.MoveHere 旧フォルダ.Items, &H10

尚、作業用の新パスをMkDir、RmDir を使って、作成/削除する
ことも可能です。

この回答へのお礼

ご回答ありがとうございます。

とりあえず「C:\VBA\」にファイルを1つだけ入れて実行してみたところ、ずっと実行中のままになってしまいました。（中断時の「位置」の値は「3」、「有効数」は「2」でした）

ところで、提示していただいたサンプルコードですが、「バッファ」や「有効数」の部分がいまいち理解できません。

「Do Until EOF(1)」のループのところで、普通は1行ずつ処理するところを、配列を導入することによって複数行の処理ができるようにしているのだろうということは何となくわかりますが、1つ1つの処理を追っていくと「？？？」状態です。

あつかましいお願いですが、今後の勉強のためにも少し解説していただけないでしょうか。
もちろん、お時間があればで結構です。

お礼日時：2010/10/13 15:29