Excel VBA質問箱 IV

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

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


55466 / 76732 ←次へ | 前へ→

【26040】Re:Input #ステートメントについて
回答  りん E-MAIL  - 05/6/22(水) 14:30 -

引用なし
パスワード
   よち さん、こんにちわ。

>この処理には、前段階で、2項目目の日時をIFで判別しています。

Sub test()
  Dim JJ&, NN&, RR&, A$, wb As Workbook, ws As Worksheet
  Application.ScreenUpdating = False '処理を画面に表示しない
  '作業用ブックを作成
  Set wb = Application.Workbooks.Add
  With wb.Worksheets(1)
   'Dドライブのルートにtest.csvという名前で保存してあるとして
   Open "d:\test.txt" For Input As #1
     Do Until EOF(1)
      NN& = NN& + 1
      Line Input #1, A$ 'とりあえず区切らずに読み込む
      .Cells(NN&, 1).Value = A$ '転記用
      .Cells(NN&, 2).Value = A$ '区切り用
     Loop
   Close #1
   'B列で区切る:データ→区切り位置→タブやカンマ(略)
   .Range(.Cells(1, 2), .Cells(NN&, 2)).TextToColumns Destination:=.Range("B1"), _
      DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Comma:=True
   For RR& = 1 To NN&
     '区切ったものはB列から始まるので、日付は3列目
     '日付で抽出(時刻は小数なので切り捨てて分岐)
     Select Case Int(.Cells(RR&, 3).Value)
      Case DateSerial(2005, 2, 25) To DateSerial(2005, 2, 26)
        JJ& = JJ& + 1
        'マクロのあるブックの左端のシートに転記(読み込んだままの文字列)
        ThisWorkbook.Worksheets(1).Cells(JJ&, 1).Value = .Cells(RR&, 1).Value
     End Select
   Next
  End With
  '再カット
  If JJ& > 0 Then
   Application.DisplayAlerts = False
   With ThisWorkbook.Worksheets(1)
     .Range(.Cells(1, 1), .Cells(NN&, 1)).TextToColumns Destination:=.Range("A1"), _
        DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Comma:=True
   End With
   Application.DisplayAlerts = True
  End If
  '作業用ブックを保存しないで閉じる
  wb.Saved = True: wb.Close
  Application.ScreenUpdating = True '処理を画面に表示する
  Set wb = Nothing
End Sub

直接当該ブックによみこまずに、作業ブックをつくって、処理後破棄するようにしています。
処理を繰返すならば、転記先のシートの値の範囲をクリアしてから読み込むようにして下さい。
0 hits

【26034】Input #ステートメントについて よち 05/6/22(水) 12:15 質問
【26035】Re:Input #ステートメントについて りん 05/6/22(水) 12:38 回答
【26037】Re:Input #ステートメントについて よち 05/6/22(水) 12:58 質問
【26040】Re:Input #ステートメントについて りん 05/6/22(水) 14:30 回答
【26048】Re:Input #ステートメントについて よち 05/6/22(水) 16:09 お礼
【26036】Re:Input #ステートメントについて(その2... りん 05/6/22(水) 12:42 回答
【26045】Re:Input #ステートメントについて だるま 05/6/22(水) 14:57 回答
【26049】Re:Input #ステートメントについて よち 05/6/22(水) 16:12 お礼

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