Excel VBA質問箱 IV

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

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


27816 / 76732 ←次へ | 前へ→

【54231】Re:指定のファイルをインポートしてグループ別のファイルを出力するVBA
回答  りん E-MAIL  - 08/3/1(土) 12:33 -

引用なし
パスワード
   まんじゅう さん、こんにちわ。
遅くなってすみません。さっき気づきました。

>最新のプログラムで出力するファイル名の名前を変更したいと考えています。
>先頭番号2のファイルの80バイトから81バイトで各グループごと
>に同じ番号が入っております。

「1」はキープしておき、最初に出てきた「2」でファイル名を決定して書き出しています。
Sub test()
  Dim s1 As String, s2 As String, flg As Boolean, II As Long, NN As Long, LL As Long
  Dim Ifile As String, Ofile As String
  ReDim Ofiles(1 To 10) As String 'とりあえず10個
  Ifile = "C:\D\InputData.TXT" '読みこむファイル
  Ofile = "C:\D\out__.txt"  '書き出すファイル __ 部に文字が入る
  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
     If Left(s1, 1) = "1" Then
      '1の時はキープ
      s2 = s1
     Else
      'ファイルを開いていなければFile Open
      If flg = False Then GoSub OutOp
      Print #2, s1
      '8を書きこんだらFile Close
      If Left(s1, 1) = "8" Then GoSub OutCl
     End If
   Loop
  Close #1
  '念のため、開きっぱなしのファイルがないかチェック
  If flg = True Then GoSub OutCl
  '
  '最終行の追加(9じゃない時を考慮して分岐を入れました)
  If Left(s1, 1) = "9" Then
   For II = 1 To NN
     '追加モードで開き、書き込みます
     Open Ofiles(II) For Append As #2
      Print #2, s1
     Close #2
   Next
  End If
  'メイン終了
  Erase Ofiles
Exit Sub
'書き出すファイルを開くサブルーチンです
OutOp:
  NN = NN + 1
  If NN > UBound(Ofiles) Then ReDim Preserve Ofiles(1 To NN) As String '拡張
  '80-81バイト目を切り出してファイル名決定
  Ofiles(NN) = Replace(Ofile, "__", StrConv(MidB(StrConv(s1, vbFromUnicode), 80, 2), vbUnicode))
  'ファイルオープン
  Open Ofiles(NN) For Output As #2
  If s2 <> "" Then Print #2, s2
  '
  flg = True
Return
'書き出すファイル閉じるサブルーチンです
OutCl:
  Close #2
  s2 = ""
  flg = False
Return
End Sub

こんな感じです。

0 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 回答

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