検索した文字列がある行を検索するには

質問

OPEN "A.txt"
QWER gohjoij
OPEN "B.txt"
OPEN "QWERT"
Write A.txt jortyu
end
と書かれたテキストファイル（ファイル名を"ABC.txt"とする。）があるとします。これを
１．OPEN "*.*"(*=ワイルドカード)という文字列の*.*のみに絞る
２．"１．"の内"　"の中に、"."が無い文字列は無視する
うえでリッチテキストボックス１に出力するようにします。リッチテキストボックス１には
A.txt
B.txt
と出力されました。これをさらに[A.txt　B.txt]がある行全体を、
１．別のリッチテキストボックス（リッチテキストボックス２）に出力する
やり方がわかりません。この例だと、リッチテキストボックス２には
OPEN "A.txt"
OPEN "B.txt"
Write A.txt jortyu
と出力したいです。今のスキルだと到底作れそうに無いので、どなたか教えてください。

回答No.4

BlueRay · ベストアンサー

またまた、BlueRayです。
>以前はOPEN "*.*"の他に、OPEN "."、OPEN "*."、OPEN ".*"でも検索する形で問題なかったのですが、
>OPEN "*.*"のみ検索する形に変えられないでしょうか。
>OPEN "."、OPEN "a."、OPEN ".Null"などは除外する。OPEN "a.b"のみ拾う。

そして、またまたSplit関数です。(^^;
以下の各文字列を「．」でSplitすると配列（２）になります。
その１番目と２番目の数を数えて、両方とも１以上でＯＫにすればできます。
　．　→０　０
＊．　→Ｎ　０
　．＊→０　Ｎ
＊．＊→Ｎ　Ｎ
※Ｎは、複数文字列

如何でしょうか。俺って、Split関数好きだなぁ(^^;

お礼

Nは真、Oは虚と言うことですよね？なるほど、参考になりました。ありがとうございます。

回答No.6

taisuke555

No.5に追加です。
[\]のあった場合の処理です。

dt = trim(Mid(strdat, pDB1 + 1, pDB2 - pDB1 - 1))
dot = InStr(dt, ".")

↓
dt = Trim(Mid(strdat, pDB1 + 1, pDB2 - pDB1 - 1))
If (InStr(dt, "\") > 0) Then '[\]がある場合
dot = InStr(Right(dt, Len(dt) - InStrRev(dt, "\")), ".")
Else
dot = InStr(dt, ".")
End If

さらにファイル名のみ取得する場合です。
↓
dt = Trim(Mid(strdat, pDB1 + 1, pDB2 - pDB1 - 1))
If (InStr(dt, "\") > 0) Then '[\]がある場合
dt = Right(dt, Len(dt) - InStrRev(dt, "\"))
End If
dot = InStr(dt, ".")

お礼

ありがとうございます。本日はお休みのため、月曜日にでも試してみようと思います。

回答No.5

taisuke555

若干バグがあったので、もう一度書きます。

Private Sub Fileread(FL As String)
Dim Fileno As Integer

Dim pot1 As Integer
Dim pDB1 As Integer
Dim pDB2 As Integer
Dim pDB3 As Integer
Dim dot As Integer

Dim strdat As String
Dim dt As String

Dim i As Integer
Dim flg As Byte
Dim flno As Integer
Dim fldat() As String

Fileno = FreeFile
Open FL For Input As #Fileno 'フォルダをセットする

flno = -1
While Not EOF(Fileno)
Line Input #Fileno, strdat '行データを読み込む

pot1 = InStr(UCase(strdat), "OPEN")
While (pot1 > 0)
pDB1 = InStr(pot1 + 1, strdat, Chr(&H22))
While (pDB1 > 0)
If (InStr(Mid(strdat, pot1 + 1, pDB1 - pot1 - 1), ":") = 0) Then 'OPENから１つ目の["]迄に[:]がない
pDB2 = InStr(pDB1 + 1, strdat, Chr(&H22))
If (pDB2 > 0) Then
dt = trim(Mid(strdat, pDB1 + 1, pDB2 - pDB1 - 1))
dot = InStr(dt, ".")
If (dot > 1 And dot < Len(dt)) Then '["]の間に[.]があり最初か最後で無い場合
'同一ファイル名チェック
flg = 0
For i = 0 To flno
If (fldat(i) = dt) Then
flg = 1
Exit For
End If
Next i
If (flg = 0) Then
flno = flno + 1
ReDim Preserve fldat(flno)
fldat(flno) = dt
Text1 = Text1 & dt & vbCrLf
End If
End If
pDB3 = InStr(pDB2 + 1, strdat, Chr(&H22)) '３つ目の["]
If (pDB3 > 0) Then
dt = Trim(Mid(strdat, pDB2 + 1, pDB3 - pDB2 - 1)) '２つ目の["]と３つ目の["]の間
'If (InStr(dt, ":") = 0 And (Left(dt, 1) = "+" Or Left(dt, 1) = "&") And (Right(dt, 1) = "+" Or Right(dt, 1) = "&")) Then
'If (InStr(dt, ":") = 0 And (Left(dt, 1) = "+" Or Left(dt, 1) = "&" Or Left(dt, 1) = ",") And (Right(dt, 1) = "+" Or Right(dt, 1) = "&" Or Right(dt, 1) = ",")) Then
If (dt = "" Or (InStr(dt, ":") = 0 And (Left(dt, 1) = "+" Or Left(dt, 1) = "&" Or Left(dt, 1) = ",") And (Right(dt, 1) = "+" Or Right(dt, 1) = "&" Or Right(dt, 1) = ","))) Then
pDB1 = pDB3
Else
pDB1 = 0
End If
pot1 = pDB2
Else
pot1 = pDB2 '２つ目の["]
pDB1 = 0
End If
Else
pot1 = pDB1 '１つ目の["]
pDB1 = 0
End If
Else
pDB1 = 0
End If
Wend
pot1 = InStr(pot1 + 1, UCase(strdat), "OPEN")
Wend
Wend

Close #Fileno

Fileno = FreeFile
Open FL For Input As #Fileno 'フォルダをセットする

While Not EOF(Fileno)
Line Input #Fileno, strdat '行データを読み込む
For i = 0 To flno
If (InStr(strdat, fldat(i)) > 0) Then
Text2 = Text2 & strdat & vbCrLf
Exit For
End If
Next i
Wend

Close #Fileno
End Sub

*.*の処理は１つ目と２つ目の["]の中の[.]が無いか、[.]の位置が１番前か(.*)
１番後ろ(*.)の場合は、処理をしないようにしています。
また、バグがあったら教えてください。

回答No.3

taisuke555

少し長くなりますが、

Private Sub Fileread(FL As String)
Dim Fileno As Integer

Dim pot1 As Integer
Dim pDB1 As Integer
Dim pDB2 As Integer
Dim pDB3 As Integer

Dim strdat As String
Dim dt As String

Dim i As Integer
Dim flg As Byte
Dim flno As Integer
Dim fldat() As String

Fileno = FreeFile
Open FL For Input As #Fileno 'フォルダをセットする

flno = -1
While Not EOF(Fileno)
Line Input #Fileno, strdat '行データを読み込む

pot1 = InStr(UCase(strdat), "OPEN")
While (pot1 > 0)
pDB1 = InStr(pot1 + 1, strdat, Chr(&H22))
While (pDB1 > 0)
If (InStr(Mid(strdat, pot1 + 4, pDB1 - pot1 - 4), ":") = 0) Then 'OPENから１つ目の["]迄に[:]がない
pDB2 = InStr(pDB1 + 1, strdat, Chr(&H22))
If (pDB2 > 0) Then
dt = Mid(strdat, pDB1 + 1, pDB2 - pDB1 - 1)
If (InStr(dt, ".")) Then '["]の間に[.]があるか
'同一ファイル名チェック
flg = 0
For i = 0 To flno
If (fldat(i) = dt) Then
flg = 1
Exit For
End If
Next i
If (flg = 0) Then
flno = flno + 1
ReDim Preserve fldat(flno)
fldat(flno) = dt
Text1 = Text1 & dt & vbCrLf
End If
End If
pDB3 = InStr(pDB2 + 1, strdat, Chr(&H22)) '３つ目の["]
If (pDB3 > 0) Then
dt = Trim(Mid(strdat, pDB2 + 1, pDB3 - pDB2 - 1)) '２つ目の["]と３つ目の["]の間
'If (InStr(dt, ":") = 0 And (Left(dt, 1) = "+" Or Left(dt, 1) = "&") And (Right(dt, 1) = "+" Or Right(dt, 1) = "&")) Then
'If (InStr(dt, ":") = 0 And (Left(dt, 1) = "+" Or Left(dt, 1) = "&" Or Left(dt, 1) = ",") And (Right(dt, 1) = "+" Or Right(dt, 1) = "&" Or Right(dt, 1) = ",")) Then
If (dt = "" Or (InStr(dt, ":") = 0 And (Left(dt, 1) = "+" Or Left(dt, 1) = "&" Or Left(dt, 1) = ",") And (Right(dt, 1) = "+" Or Right(dt, 1) = "&" Or Right(dt, 1) = ","))) Then
pDB1 = pDB3
Else
pot1 = pDB2
pDB1 = 0
End If
Else
pot1 = pDB2 '２つ目の["]
pDB1 = 0
End If
Else
pot1 = pDB1 '１つ目の["]
pDB1 = 0
End If
Else
pDB1 = 0
End If
Wend
pot1 = InStr(pot1 + 1, UCase(strdat), "OPEN")
Wend
Wend

Close #Fileno

Fileno = FreeFile
Open FL For Input As #Fileno 'フォルダをセットする

While Not EOF(Fileno)
Line Input #Fileno, strdat '行データを読み込む
For i = 0 To flno
If (InStr(strdat, fldat(i)) > 0) Then
Text2 = Text2 & strdat & vbCrLf
Exit For
End If
Next i
Wend

Close #Fileno
End Sub

************* テストファイル ****************
'**************************
'OPENについてのファイル名取得テスト
'**************************
OPEN "OPEN.text" for input as #1

print "a1.abc"
print "aa.abc" '....（１）

open "test.txt"
OPEN "C:temp",OPEN "ASD.txt"

open "c:\test" + dir + "abc.txt"
OPEN ABC+BCD
OPEN ABC:print "zzz.abc"

open "a1.abc","a2.abc","a3.abc":open "a4.abc"
open "c1.abc"+"c2.abc"
open "d1.abc" , ABC + "d2.abc"

print "e1.abc":open "e2.abc"
open "f1.abc" + ABC :print ABC + "f2.abc"

open "abc""g1.abc"

print ABC
print a1.abc

************* 実行結果 ****************
Text1:
OPEN.text
test.txt
ASD.txt
a1.abc
a2.abc
a3.abc
a4.abc
c1.abc
c2.abc
d1.abc
d2.abc
e2.abc
f1.abc
g1.abc

Text2:
OPEN "OPEN.text" for input as #1
print "a1.abc"
open "test.txt"
OPEN "C:temp",OPEN "ASD.txt"
open "a1.abc","a2.abc","a3.abc":open "a4.abc"
open "c1.abc"+"c2.abc"
open "d1.abc" , ABC + "d2.abc"
print "e1.abc":open "e2.abc"
open "f1.abc" + ABC :print ABC + "f2.abc"
open "abc""g1.abc"
print a1.abc

１．OPEN から["]の間に[:]がある場合、他の命令とする。
２．２つ目の["]から３つ目の["]（ある場合）の間に[:]がある場合、他の命令とする。
　　ない場合、最初の文字が[なし]OR[,]OR[+]OR[&]ならば、同一命令とし、さらに検索する。
　　　　　　　その他の場合は他の命令とする。
３．同じファイル名の場合は、表示しない。
４．ファイルを再OPENし、１行目からText1に書かれたファイル名で検索する。

テストファイル（１）行のような場合に対応するため、再OPENしています。
このような場合が無ければ、再OPENせずNo.2の方のようにしても問題ないと思います。
本格的なデバッグはしていません。確認してください。
Split命令でのプログラムを考えようと思いましたが、私自身、あまり使った事が無いので、今回は、やめました。

もう１つの質問と一緒になっています。

お礼

taisuke555さん、お世話になります。何度も助けていただき、感謝しています。

補足

以前はOPEN "*.*"の他に、OPEN "."、OPEN "*."、OPEN ".*"でも検索する形で問題なかったのですが、OPEN "*.*"のみ検索する形に変えられないでしょうか。

OPEN "."、OPEN "a."、OPEN ".Null"などは除外する。OPEN "a.b"のみ拾う。

自力ではとても無理そうなので、ご教示お願いします。

回答No.2

BlueRay

少し勘違いがあったみたいです。
リッチテキスト１に表示される文字列を含む行を対象として
リッチテキスト２に表示するわけですね。
では、以下のようにしてみては如何でしょうか。
説明：
はじめのループで、対照の文字列（"*.*"）があるかどうか検索
見つかった場合は、リッチテキスト１へ表示＆配列に格納。
次のループで今読み込んでいる行に、配列にある文字列が存在するか
どうかチェックして、見つかれば現在の行をリッチテキスト２へ表示。

'**********　ここから　**********
Dim i As Integer
Dim idx As Integer
Dim divStr() As String
Dim strTarget() As String

idx = 0
divStr = Split(strdat, """")
For i = 0 To UBound(divStr)
　　If (i Mod 2) = 1 Then
　　　　If InStr(divStr(i), ".") > 0 Then
　　　　　　RichTextBox1.Text = RichTextBox1.Text & divStr(i) & vbCrLf
　　　　　　'対象の文字列を一度配列に格納しておく。
　　　　　　Redim strTarget(idx)
　　　　　　strTarget(idx) = divStr(i)
　　　　　　idx = idx + 1
　　　　End If
　　End If
Next
'strdatの中に対象配列の文字列が含まれるかチェックする。
For i = 0 To UBound(strTarget)
　　If Instr(strdat, strTarget(i)) > 0 Then
　　　　'対象文字列が含まれていたら、以後のチェックは不要なのでループを終了する。
　　　　RichTextBox2.Text = RichTextBox2.Text & strdat & vbCrLf
　　　　Exit For
　　End If
Next
'**********　ここまで　**********

お礼

ありがとうございます。BlueRayさん、No.3の方、ともによく出来ており、甲乙つけがたいです。コードは今まで使っていたものより、シンプルでわかりやすくてよいのですが、No.3の方のほうは、
＞２．２つ目の["]から３つ目の["]（ある場合）の間に[:]がある場合、他の＞命令とする。 ない場合、最初の文字が[なし]OR[,]OR[+]OR[&]ならば、同＞　　一命令とし、さらに検索する。その他の場合は他の命令とする。
＞３．同じファイル名の場合は、表示しない。
と細かい条件まで満たしているので、そちらを軸に使わせてもらうことにしました。BlueRayさん、本当にお世話になりました。また機会がありましたら、よろしくお願いします。

回答No.1

BlueRay

Q.345637で回答したロジックに追加

以下は、指定文字列の取り出しだけのロジックです。参考にしてみてください。
'**********　ここから　**********
Dim i As Integer
Dim divStr() As String

divStr = Split(strdat, """")
For i = 0 To UBound(divStr)
　　If (i Mod 2) = 1 Then
　　　　If InStr(divStr(i), ".") > 0 Then
　　　　　　RichTextBox1.Text = RichTextBox1.Text & divStr(i) & vbCrLf
　　　　　　RichTextBox2.Text = RichTextBox2.Text & strdat & vbCrLf
　　　　End If
　　End If
Next
'**********　ここまで　**********

お礼

もう一つの質問にも丁寧に答えていただき、本当に感謝しています。この回答も非常に役立ちました。ありがとうございます。

補足

例.
ファイル名をA.txtとする

＜A.txtの中身＞
OPEN "A.txt"
QWER gohjoij 　　　　　　＜RichTextBox1>
OPEN "B.txt"　　　→　 　　　　A.txt
OPEN "QWERT"　　　　　　 　　B.txt
Write A.txt jortyu
end

<RichTextBox1(RTB1)>　　　<RichTextBox2(RTB2)>
A.txt 　　　　　　　　　　　→　　　　OPEN "A.txt"
B.txt 　　　　　　　　　　　　　　　　OPEN "B.txt"
　　　　　　　　　　　　　　　　　　　Write A.txt jortyu（A.txtの中身の内、RTB1の文字列のある行）

↑の用にしたいのですが、現状ではRTB2には"Write A.txt jortyu"が出ていません。ここをどう直したらよいか教えてください（今のままだと、１回目の検索で出た文字列のある行が、そのまま出力されているので、２回目の検索は、また別にプログラムしなければいけないことはわかるのですが）。