Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


27994 / 76732 ←次へ | 前へ→

【54051】Re:指定のファイルをインポートしてグループ別のファイルを出力するVBA
回答  りん E-MAIL  - 08/2/21(木) 18:46 -

引用なし
パスワード
   まんじゅう さん、こんばんわ。

>グループ別(先頭1,2,8データ)の分離した各データの末尾に
>先頭9のデータをつけることは可能でしょうか
最後のレコードを追加したいということですか?
配列に入れて処理する方法も考えましたが、一旦書き出したファイルに1行追加する方法でいきます。

Sub test()
  Dim s1 As String, flg As Boolean, II As Long, NN As Long, LL As Long
  Dim Ifile As String, Ofile As String
  Ifile = "C:\D\InputData.TXT"'読みこむファイル
  Ofile = "C:\D\out___.txt"  '書き出すファイル ___ 部に3ケタの数字が入る
  flg = False
  '
  Open Ifile For Input As #1
   Do Until EOF(1)
     Line Input #1, s1
     '9だったらループから出る
     If Left(s1, 1) = "9" Then Exit Do
     'ファイルを開いていなければFile Open
     If flg = False Then GoSub OutOp
     Print #2, s1
     '8を書きこんだらFile Close
     If Left(s1, 1) = "8" Then GoSub OutCl
   Loop
  Close #1
  '念のため、開きっぱなしのファイルがないかチェック
  If flg = True Then GoSub OutCl
  '
  '最終行の追加(9じゃない時を考慮して分岐を入れました)
  If Left(s1, 1) = "9" Then
   For II = 1 To NN
     '追加モードで開き、書き込みます
     Open Replace(Ofile, "___", Format(II, "000")) For Append As #2
      Print #2, s1
     Close #2
   Next
  End If
  'メイン終了
Exit Sub
'書き出すファイルを開くサブルーチンです
OutOp:
  NN = NN + 1
  Open Replace(Ofile, "___", Format(NN, "000")) For Output As #2
  flg = True
Return
'書き出すファイル閉じるサブルーチンです
OutCl:
  Close #2
  flg = False
Return
End Sub

こんな感じです。
ファイル名の部分もちょっと変えました。
1 hits

【54011】指定のファイルをインポートしてグループ別のファイルを出力するVBA まんじゅう 08/2/20(水) 2:10 質問
【54012】Re:指定のファイルをインポートしてグルー... りん 08/2/20(水) 6:20 回答
【54027】Re:指定のファイルをインポートしてグルー... まんじゅう 08/2/20(水) 15:19 質問
【54033】Re:指定のファイルをインポートしてグルー... りん 08/2/20(水) 19:07 回答
【54040】Re:指定のファイルをインポートしてグルー... まんじゅう 08/2/21(木) 10:18 質問
【54051】Re:指定のファイルをインポートしてグルー... りん 08/2/21(木) 18:46 回答
【54057】Re:指定のファイルをインポートしてグルー... まんじゅう 08/2/22(金) 10:50 お礼
【54135】Re:指定のファイルをインポートしてグルー... まんじゅう 08/2/26(火) 2:50 質問
【54231】Re:指定のファイルをインポートしてグルー... りん 08/3/1(土) 12:33 回答

27994 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free