句点で改行

テキストを句点で改行して空白行を1行入れる編集をしたいのですが、どのようにコーディングすればよいのでしょうか？

No.4 ベストアンサー 回答者： noname#22222 回答日時： 2006/06/03 14:44

＜Test.txt＞

これはテストです。句点で改行させるコード用。果たして成功するかな。
↓
＜Test2.txt＞

これはテストです。
句点で改行させるコード用。
果たして成功するかな。

Test.txtをリードしANo1さんの回答に従って改行させTest2.txtに書き出すには４行程のコードを書く必要があります。（ただし、関数が存在すれば...）

Private Sub CommandButton1_Click()
　　Dim strText As String
　　
　　strText = FileReadAll("d:\temp\test.txt")
　　strText = Replace(strText, "。", "。" & vbCrLf)
　　FileWrite "d:\temp\tset2.txt", strText
End Sub

※Excel2003で検証！

**********************************************************************

このコードが動作するには、
１、以下のFileRearAll関数、FileWrite関数を標準モジュールに追加して下さい。
２、参照設定にMicrosoft Scripting Runtime を追加して下さい。

Option Explicit

Public Function FileWrite(ByVal FileName As String, _
　　　　　　　　　　　　　ByVal Text As String) As Boolean
On Error GoTo Err_FileWrite
　　Dim fso As FileSystemObject
　　Dim txs As TextStream
　　
　　Set fso = New FileSystemObject
　　Set txs = fso.CreateTextFile(FileName, True)
　　txs.Write Text
　　FileWrite = True
Exit_FileWrite:
　　Exit Function
Err_FileWrite:
　　MsgBox Err.Description & "(FileWrite)", vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_FileWrite
End Function

Public Function FileReadAll(ByVal FileName As String) As String
On Error GoTo Err_FileReadAll
　　 Dim fso As FileSystemObject
　　 Dim fil As File
　　 Dim txs As TextStream
　　
　　 Set fso = New FileSystemObject
　　 Set fil = fso.GetFile(FileName)
　　 Set txs = fil.OpenAsTextStream(ForReading, TristateUseDefault)
　　 FileReadAll = txs.ReadAll
Exit_FileReadAll:
　　 Exit Function
Err_FileReadAll:
　　 MsgBox Err.Description & "(FileReadAll)", vbExclamation, " 関数エラーメッセージ"
　　 Resume Exit_FileReadAll
End Function

この回答へのお礼

無事動きました。ありがとうございました。(^_^)

お礼日時：2006/06/03 15:18

No.8 回答者： KenKen_SP 回答日時： 2006/06/04 14:40

> GetText = で、「変数が定義されていません。

」というメッセージが出ました。

あ。。。次のように訂正します。

GetText = Space$(FileLen(strFilename))
　　　　　↓
Buffer = Space$(FileLen(strFilename))

WEB 投稿するテキストを編集した際の単純なミスです。すみません。

この回答へのお礼

無事動きました。ｍ(_"_)ｍ　でも、どこに書かれたのでしょうか^^;

お礼日時：2006/06/04 15:22

No.7 回答者： KenKen_SP 回答日時： 2006/06/04 11:41

こんにちは。

テキストファイル操作を今から覚えるのであれば、 s_husky さんが使われて
いる FileSystemObject の方が良いのですが、昔ながらの Open、Get、Put
ステートメントを使った場合のサンプルとしてご紹介します。

一応 Excel VBA で書きましたが、VB であっても Application.GetOpenFilename
が CommonDialog コントロールに変わるだけで、多少の変更で動きます。

指定したテキストファイルと同一のフォルダに結果を書き出します。


Option Explicit

Sub Sample()

　　Dim strFilename As String
　　Dim strDir　　　As String
　　Dim Buffer　　　As String
　　Dim n　　　　　 As Long
　　Const cnsOUTPUT As String = "_Output.txt"

　　'テキストファイルの指定
　　strFilename = Application.GetOpenFilename("テキストファイル,*.txt")
　　If UCase$(strFilename) = "FALSE" Then
　　　　Exit Sub
　　Else
　　　　strDir = Left$(strFilename, InStrRev(strFilename, "\"))
　　End If

　　On Error GoTo ERROR_HANDLER
　　
　　'バイナリとしてテキストを読み込み
　　n = FreeFile()
　　GetText = Space$(FileLen(strFilename))
　　Open strFilename For Binary As #n
　　　　Get #n, , Buffer
　　Close #n

　　'「句点」の全半角を統一
　　Buffer = Replace(Buffer, "。", "。")
　　'「句点」→「句点＋改行コード＋改行コード」に置換
　　Buffer = Replace(Buffer, "。", "。" & vbCrLf & vbCrLf)

　　'テキスト出力
　　n = FreeFile()
　　Open strDir & cnsOUTPUT For Binary As #n
　　　　Put #n, , Buffer
　　Close #n
　　Exit Sub

ERROR_HANDLER:
　　Close #n
　　MsgBox "Error(" & Err.Number & ")" & vbCrLf _
　　　　　 & Err.Description
End Sub

この回答へのお礼

ご回答ありがとうございます。GetText = で、「変数が定義されていません。」というメッセージが出ました。ｍ(_"_)ｍ

お礼日時：2006/06/04 12:21

No.6 回答者： imogasi 回答日時： 2006/06/03 18:48

＃５です。

＞openのところで、「ファイルが見つかりません
私のコードをそのまま実行してませんか。自分のメモ帳で作ったファイル名に変えること。これをユーザーに指定させるようにも、コードかけますが。
とりあえずＯｐｅｎの”　”の中を自分のケースに変え実行してみてください。その実行後text9.txtを開いてみてください。

この回答への補足

すいません。ファイル名間違えていました。次のステップに進みまして、If Mid(s, Len(s), 1) <> "。" Thenのところで、「プロシージャの呼び出し、または引数が不正です。(Error 5)」となりました。ｍ(_"_)ｍ

補足日時：2006/06/03 19:17

この回答へのお礼

途中まで、書かれていました。一行ずつ、句点が着いていました…。空白行のあるところで、エラーになったようです。(^_^;)

お礼日時：2006/06/03 19:28

No.5 回答者： imogasi 回答日時： 2006/06/03 16:11

＃２です。

補足に対して
コード
Sub testo1()
Open "text8.txt" For Input As #1
Open "text9.txt" For Output As #2
While Not EOF(1)
Line Input #1, s
st = 1: sn = ""
'---
If Mid(s, Len(s), 1) <> "。" Then
s = s & "。"
End If
'--
Do
p = InStr(st, s, "。")
sn = sn & Mid(s, st, p - st + 1) & vbCrLf & vbCrLf
st = p + 1
If p = Len(s) Then GoTo p1
Loop
'---
p1:
Print #2, Left(sn, Len(sn) - 2)
Wend
'---
Close #1
Close #2
End Sub

（例データ）text8.txt
そういう場合は、良く考えてください。即断し無いようにしましょう。急いでも良い知恵は出てきません。
ご回答ありがとうございます。ファイルはエクセルシート、ワードでも良いです。出力するまでのコードがあると嬉しいです。入力の部分も書かれていると嬉しいです。よろしくお願いします。
（結果）text9.txt
そういう場合は、良く考えてください。

即断し無いようにしましょう。

急いでも良い知恵は出てきません。

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

ファイルはエクセルシート、ワードでも良いです。

出力するまでのコードがあると嬉しいです。

入力の部分も書かれていると嬉しいです。

よろしくお願いします。

この回答へのお礼

openのところで、「ファイルが見つかりません。」というメッセージが出てしまいました。(^_^;)　アドレス指定してもダメなのでしょうか？ありがとうございました。ｍ(_"_)ｍ

お礼日時：2006/06/03 18:15

No.3 回答者： imogasi 回答日時： 2006/06/03 13:46

＃２です。

＃２の補足・お礼に関して。
カテがＶＢであること、プログラムの質問であることから、入力
出力はわかる力がある方と仮定しましたが・・。
エクセルかワードで、ということだとＶＢＡですね。ＶＢから入る質問も出る事があるが。
またＷｏｒｄＶＢＡは経験者が少ないようです。
エクセルなら、入力したシート、セルの状態を決めて（教えて）もらわないと、プログラムができません。エクセルＶＢＡを触ったら判るでしょう。セル番地がコードの中に頻繁に出てくることを。
もう既にテキストは、エクセル・ワードなどに打ち込んであるのですか。
まだならメモ帳に打ち込んで、または貼り付けて、質問するのが、本質問の既に出ている、諸回答が生かせ易いのでは無いかと思います。

この回答への補足

説明不足ですいません。メモ帳に貼り付けてあります。エクセルVBAの方が良いです。(^_^;)

補足日時：2006/06/03 13:49

No.2 回答者： imogasi 回答日時： 2006/06/03 11:56

Sub testo1()

s = "そういう場合は、良く考えてください。即断し無いようにしましょう。急いでも良い知恵は出てきません。"
st = 1: sn = ""
Do
p = InStr(st, s, "。")
' MsgBox p
If p = 0 Then GoTo p1
sn = sn & Mid(s, st, p - st + 1) & vbCrLf & vbCrLf
st = p + 1
Loop
p1:
MsgBox sn
End Sub
をご参考に。
＞テキストを
テキスト「ファイル」の状態ですか。
新しいテキストファイルをテキストファイルで出力するのですか。
まあそうだとしても、その辺は、判るでしょう。

この回答への補足

ご回答ありがとうございます。ファイルはエクセルシート、ワードでも良いです。出力するまでのコードがあると嬉しいです。入力の部分も書かれていると嬉しいです。よろしくお願いします。ｍ(_"_)ｍ

補足日時：2006/06/03 12:47

この回答へのお礼

ありがとうございます。メッセージボックスで表示していたのですね。早いですね。(^_^;)　でも、コピーができないので、コピーできるものに出力できたらと思います。お願いします。ｍ(_"_)ｍ

お礼日時：2006/06/03 12:57

No.1 回答者： Kuppycat 回答日時： 2006/06/03 11:53

dim str as string

str = "サンプルです。サンプルです。"
str = replace$(str, "。","。" & vbCrLf)

こんな感じかな。
vbCrLfはキャリッジリターンラインフィード。
chr(13) & chr(10) のVB定義定数です。

この回答への補足

ありがとうございます。早速試してみましたが、出力のコードがありません。どのようにコーディングするのでしょうか。よろしくお願いします。ｍ(_"_)ｍ

補足日時：2006/06/03 12:45