置換？について

質問

いつもお世話になっております。sako77です。
今回は置換？について質問させていただきます。

ファイルＡ（テキストファイル）に以下のような文章があります。
例）

おはようございます。今日も●●●です。こんにちは。今日も◆◆◆◆です。おやすみ今日も■■です。・・・

上記のようなテキスト文章から「今日も」から「です」の間の文字列を抽出し、別テキストファイルＢに

●●●●
◆◆◆◆
■■

のように出力したいのですが、こんなことはできるのでしょうか？
エクセルかアクセス又はこんなことができるソフトがあれば教えてください。
よろしくお願い致します。

回答No.3

mitarashi · ベストアンサー

A No.1です。
subMatchが何個まで対応できるか気になったので、長いテキストで試験してみましたが、その際、このケースではsubMatchは常に1個だけである事に気付きました。今回、沢山できるのはMatchの方で、500個位あっても動作しました。下記は、テキストファイルを読む、修正版です。
Sub test2()
Dim regEX As Variant
Dim Matches As Variant
Dim match As Variant
Dim matchString As String
Dim targetString As String
Dim subMatch As Object

targetString = readTextFile("C:\Documents and Settings\??????\My Documents\hoge.txt")
matchString = "今日も([^。]*)です。"
Set regEX = CreateObject("VBScript.RegExp")
regEX.MultiLine = True
regEX.Pattern = matchString
regEX.ignorecase = True
regEX.Global = True
Set Matches = regEX.Execute(targetString)
For Each match In Matches
If match.submatches.Count > 0 Then
Debug.Print match.submatches.Item(0)
End If
Next match
Set Matches = Nothing
Set regEX = Nothing
End Sub

Private Function readTextFile(fileName As String) As String
Dim FSO As Object
Dim buf As String

Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO.getfile(fileName).OpenAsTextStream
buf = .ReadAll
readTextFile = buf
.Close
End With
Set FSO = Nothing
End Function

お礼

いろいろと検証して頂きありがとうございます。
是非参考にさせてもらいます。

回答No.5

hallo-2007

一応、関数案です。
A1に　おはようございます。今日も●●●です。こんにちは。今日も◆◆◆◆です。おやすみ今日も■■です。・・・
として
A2に　=MID(A1,FIND("今日も",A1)+3,255) 下フィル
B2に　=LEFT(A2,FIND("です",A2)-1)　　　　下フィル
では？
但し、文字数　255文字まで

お礼

回答ありがとうございます。
文字数は長いものも多々あるので上限がちょっとわからないですね。
けど、こういう方法もあるんだと勉強になりました。

回答No.4

Wendy02

こんばんは。

すでに回答は出ていますが、こんな風な感じにしてみたらいかがでしょうか。なお、Excel2000などの下位バージョンでは、この方法は、処理行が大量の場合は、うまく行かないことがあります。

実際、
>エクセルかアクセス又はこんなことができるソフトがあれば教えてください。
テキスト　-> テキストで、あえて、ExcelなどのVBAを使う必要性はないようには思います。
VBScript でも可能です。

なお、「今日もxxxx axxaxです。」の xxxx axxax は、抜き出せても、
「今日もxxxx axxaxです」は、抜き出せないようなパターンになっています。出力側が予め決められていて、アペンドモードになっています。入力側は、このマクロではダイアログ選択になっています。

--------------------------------------
Sub RegExpTest()
　　Dim Matches As Object 'MatchCollection
　　Dim Match As Object　'Match
　　Dim FileName As String
　　Dim TextLine As String
　　Dim buf As String
　　Dim inFno As Integer
　　Dim outFno As Integer
　　Dim outFname As String

　　'出力用ファイル名(要設定--質問中のテキストファイルＢ）
　　outFname = Application.DefaultFilePath & "\" & "OutTest.Txt"
　　If Dir(outFname) = "" Then
　　　 MsgBox outFname & vbCrLf & "出力ファイルがありません。", 48
　　　 Exit Sub
　　End If

　　'検索用ファイル(質問中のテキストファイルＡ)
　　FileName = Application.Application.GetOpenFilename _
　　("テキストファイル(*.txt),*.txt")
　　If FileName = "False" Then Exit Sub
　　If StrComp(FileName, outFname, 1) = 0 Then
　　　 MsgBox "出力ファイルは選べません。", 48
　　　 Exit Sub
　　End If
　　With CreateObject("VBScript.RegExp")
　　　　.Pattern = "今日も([^(です)]+)です。"

　　　　.Global = True
　　　　inFno = FreeFile()
　　　　Open FileName For Input As #inFno

　　　　Do While Not EOF(inFno)
　　　　　　Line Input #inFno, TextLine
　　　　　　If .Test(TextLine) Then
　　　　　　　　Set Matches = .Execute(TextLine)
　　　　　　　　For Each Match In Matches
　　　　　　　　　　buf = buf & vbCrLf & .Replace(Match, "$1")
　　　　　　　　Next
　　　　　　End If
　　　　Loop
　　　　　　Close #inFno
　　　　　　buf = Mid$(buf, 3)
　　　　　　outFno = FreeFile()
　　　　　　If Len(buf) > 1 Then
　　　　　　　　Open outFname For Append As #outFno
　　　　　　　　Print #outFno, buf
　　　　　　　　Close #outFno
　　　　　　　　Beep
　　　　　　End If
　　　　End With
End Sub

お礼

回答ありがとうございます。
必要な部分が抜き出せるだけで十分ですので大変ありがたいです。
本当にありがとうございました。

回答No.2

fujillin

正規表現の練習問題みたいな感じですね。
テキスト編集で、丁度、同じような例題が以下にありましたので、参考にしてください。
（もちろん、エクセルやアクセスのVBAでも可能です。）
http://ukiya.sakura.ne.jp/index.php?%E6%AD%A3%E8%A6%8F%E8%A1%A8%E7%8F%BE%E8%AC%9B%E5%BA%A7%2F1

お礼

ありがとうございました。
参考にさせてもらいます。

回答No.1

mitarashi

エクセルVBAの事例です。（アクセスでも動くと思います）
正規表現を使っています。もっとスマートなマッチングの仕方がありそうに思いますが、とりあえず出来たという事で回答とします。
テキストファイルへの出力はご自分でなさって下さい。FileSystemObjectを用いる事例を参考urlに記しました。
Sub test()
Dim regEX As Variant
Dim Matches As Variant
Dim match As Variant
Dim matchString As String
Dim targetString As String
Dim subMatch As Object
Dim i As Long

targetString = "おはようございます。今日も●●●です。こんにちは。今日も◆◆◆◆です。おやすみ今日も■■です。・・・"
matchString = "今日も([^。]*)です。"
Set regEX = CreateObject("VBScript.RegExp")
regEX.MultiLine = True
regEX.Pattern = matchString
regEX.ignorecase = True
regEX.Global = True
Set Matches = regEX.Execute(targetString)
i = 1
For Each match In Matches
If match.submatches.Count > 0 Then
For i = 0 To match.submatches.Count - 1
Debug.Print match.submatches.Item(i)
Next i
End If
Next match
Set Matches = Nothing
Set regEX = Nothing
End Sub
詳細は　VBA　正規表現　で検索してください。

参考URL：

http://officetanaka.net/excel/vba/filesystemobject/textstream.htm