Excel VBA質問箱 IV

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

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


43536 / 76732 ←次へ | 前へ→

【38243】テキストファイルの高速読込み
質問  aya  - 06/5/30(火) 15:29 -

引用なし
パスワード
   フォルダ内保存されているテキストファイルを読み込んでシートに書込みする処理を行っています。
処理速度が遅く、だいたい1レコードに1秒かかってしまい、大量のデータを処理する時にはイライラします。
自分で作ったコードを利用しながら、高速読込みを実現したいですがどうすればいいかわからず、どなたかお力を貸していただきたいと思い書込みしました。
初心者でコードにまとまりもなく、わかりづらいとは思います。すいません。

Option Explicit
  Dim strInFile   As String    '入力ファイル名
  Dim stroutFileName As String    '出力ファイル名
  Dim strBUFF    As String    'レコードを読みこむバッファ
  Dim nCNT      As Integer    'レコード数を数えるカウンタ
  Dim intFF     As Integer    'FreeFile値
  Dim i       As Integer    '文字検索カウンタ
  Dim eventNo    As String    'イベントNO
  Dim flapNo     As String    'フラップNO
  Dim inDate     As String    '入庫日付
  Dim inTime     As String    '入庫時刻
  Dim outDay     As String    '出庫日付
  Dim outTime    As String    '出庫時刻
  Dim ryoukin    As String    '料金
  Dim dat(3000, 7)  As String    '必要な情報を格納
  Dim myStatusBar  As Boolean    'ステータスバー
  Dim xlAPP     As Application  '出力ファイル
  Dim parkName    As String    '駐車場名
  Dim beginDate   As String    '指定日(開始日)
  Dim endDate    As String    '指定日(終了日)
  Dim todayDate   As String    '本日の日付
  Const strData1Sheet = "作業用"
  Const strData2Sheet = "作業用(一覧)"
   
Sub SelectData()
  Dim Name1 As String  '施設名1
  Dim Name2 As String  '施設名2
  Dim hizuke  As Integer
  Name1 = Range("C7").Value
  Name2 = Range("D7").Value
'日付フォーマット
  beginDate = Format(Range("C4").Value, "yyyymmdd")  
  endDate = Format(Range("C5").Value, "yyyymmdd")
  todayDate = Format(Range("C2").Value, "yyyymmdd")
  Worksheets("Sheet2").Activate
  nCNT = 1              '出力行カウンタを初期化
  Do Until endDate < beginDate    '開始日が終了日を上回るまでループ
START001:
  '対象ファイル読込  
  strInFile = ThisWorkbook.Path & "\" & parkName1 & "\"_
             & parkName2 & "\売上\" & beginDate & ".Txt"  
    If Dir(strInFile) = "" Then     'ファイルの存在チェック
      hizuke = Right(beginDate, 2)   '日付処理(月をまたがった時)
      If hizuke = 31 Then
        beginDate = beginDate + 70
      ElseIf hizuke = 32 Then
        beginDate = beginDate + 69
      Else
        beginDate = beginDate + 1
      End If
      GoTo START001
    End If                       
'当日の日付は受け付けない
      If todayDate = beginDate Or endDate = todayDate Then
        MsgBox "本日以前の日付を入力してください"
        Exit Sub
      End If
      intFF = FreeFile         '使用可能なファイル番号を取得
      Set xlAPP = Application
      'ファイルを入力モードで開く
      Open strInFile For Input As #intFF  
      Do Until EOF(1)      'ファイルの最終までループ
        On Error GoTo rest
      '処理中の時左下にレコード数の表示をさせる        
        xlAPP.StatusBar = "出力中です....(" & nCNT - 1 & "_
                            レコード目)"   
        'データを1行単位で読み込んで変数「strBUFF」に代入
         Line Input#intFF,strBUFF
      '初期化
        eventNo = ""
        flapNo = ""
        inDate = ""
        inTime = ""
        outDay = ""
        outTime = ""
        ryoukin = ""
        i = 0
    'strBUFF中に「IN:」がある位置を検索し、何文字目にあるかをiに代入
        i = InStr(strBUFF, "IN:")
        eventNo = Mid(strBUFF, i - 6, 2) 'イベントNOを取得
        If (eventNo <> 2) Then       'イベントNOが2以外の時
          flapNo = Mid(strBUFF, i - 4, 2) 'フラップNOを取得
          inDate = Mid(strBUFF, i + 3, 10) '入庫日付を取得
          inTime = Mid(strBUFF, i + 18, 5) '入庫時間を取得
    'strBUFF中に「OUT:」がある位置を検索し、何文字目にあるかをiに代入
          i = InStr(strBUFF, "OUT:")
    'strBUFFに△がある場合
        If InStr(strBUFF, "△") <> 0 Then
          ryoukin = Mid(strBUFF, i + 24, 9)    '料金を取得
          ryoukin = Replace(ryoukin, "△", "")   '△を削除
          ryoukin = Replace(ryoukin, "\", "")   '¥を削除
          dat(nCNT, 6) = ryoukin          '配列に代入
          Cells(nCNT + 1, 8).Value = dat(nCNT, 6) 'セルに代入
          Cells(nCNT + 1, 8).Font.ColorIndex = 3  '文字色を赤に
        Else
          ryoukin = Mid(strBUFF, i + 24, 10)    '料金を取得
          ryoukin = Replace(ryoukin, "\", "")    '¥を削除
          dat(nCNT, 6) = ryoukin          '配列に代入
          Cells(nCNT + 1, 8).Value = dat(nCNT, 6)  'セルに代入
          Cells(nCNT + 1, 8).Font.ColorIndex = 1
        End If
        outDay = Mid(strBUFF, i + 4, 10)  '出庫日付を取得
        outTime = Mid(strBUFF, i + 19, 5)  '出庫時間を取得
        dat(nCNT, 0) = eventNo       '取得した値を配列に代入
        dat(nCNT, 1) = flapNo
        dat(nCNT, 2) = inDate
        dat(nCNT, 3) = inTime
        dat(nCNT, 4) = outDay
        dat(nCNT, 5) = outTime
        Cells(nCNT + 1, 2).Value = dat(nCNT, 0)  '指定セルに書込
        Cells(nCNT + 1, 3).Value = dat(nCNT, 1)
        Cells(nCNT + 1, 4).Value = dat(nCNT, 2)
        Cells(nCNT + 1, 5).Value = dat(nCNT, 3)
        Cells(nCNT + 1, 6).Value = dat(nCNT, 4)
        Cells(nCNT + 1, 7).Value = dat(nCNT, 5)
        nCNT = nCNT + 1       'カウントをインクリメント
      End If
    Loop
    beginDate = beginDate + 1
    Close #intFF
  Loop
  Close #intFF            'ファイルを閉じる
  xlAPP.StatusBar = False      'ステータスバー非表示
  Worksheets("main").Activate
  Range("D7").Select
  Selection.ClearContents
  MsgBox nCNT - 1 & "件出力しました"          '結果を表示
  Exit Sub
rest:                          'エラー処理
  Close #intFF
  MsgBox "ファイルのデータ取得に失敗しました。"
  xlAPP.StatusBar = False          'ステータスバー非表示
End Sub


処理は読み込む際に日付と施設名を指定する為Sheet1のセルからデータを取得し、それを利用してファイル名の指定をして読込み、結果をSheet2に表示します。
テキストファイル名は例えば2006/05/01なら「20060501.Txt」となっている為に、途中でフォーマットをしています。
また日付で例えば「2006/04/30〜2006/05/01」のデータを読み込みたい場合、フォーマットをしている為に、「2006/04/31」以降のデータも探そうとしてしまいますが実際ありえない日付ですので、ファイルのあるなしで判定をかけたあと計算をして翌月の1日の日付になるようつじつまを合わせています。
もっといい方法があるのでしょうけど・・・

テキストファイルの中身は下記の通りの固定長で、1レコード1行です。
不必要なデータが入っているので途中で処理をして必要なデータだけ抜き出しています。

yyyy/mm/dd hh:mm:ss F evt:4 01: IN:2004/10/31-----22:11, OUT:2004/11/01-----08:25   \600,Receipt:0,Err:00

また料金が表示されている箇所には「△」が入っていることがあり、これはマイナスの金額になりますので、シートに書き込む際には「△」を削除し文字色を赤にしています。

どなたかアドバイスいただけませんか?
よろしくお願いします。

1 hits

【38243】テキストファイルの高速読込み aya 06/5/30(火) 15:29 質問
【38244】Re:テキストファイルの高速読込み 06/5/30(火) 15:44 回答
【38245】Re:テキストファイルの高速読込み aya 06/5/30(火) 15:55 発言
【38246】Re:テキストファイルの高速読込み Jaka 06/5/30(火) 16:00 発言
【38247】Re:テキストファイルの高速読込み Jaka 06/5/30(火) 16:07 発言
【38375】Re:テキストファイルの高速読込み aya 06/6/1(木) 9:59 質問
【38249】Re:テキストファイルの高速読込み Kein 06/5/30(火) 16:13 発言
【38376】Re:テキストファイルの高速読込み aya 06/6/1(木) 10:01 発言
【38386】Re:テキストファイルの高速読込み Kein 06/6/1(木) 14:41 回答
【38388】Re:テキストファイルの高速読込み Kein 06/6/1(木) 14:43 発言
【38254】Re:テキストファイルの高速読込み neptune 06/5/30(火) 17:21 回答
【38268】Re:テキストファイルの高速読込み ichinose 06/5/30(火) 19:56 発言
【38287】Re:テキストファイルの高速読込み neptune 06/5/30(火) 23:10 発言
【38288】Re:テキストファイルの高速読込み neptune 06/5/30(火) 23:20 発言
【38377】Re:テキストファイルの高速読込み aya 06/6/1(木) 10:16 質問
【38402】Re:テキストファイルの高速読込み ichinose 06/6/1(木) 23:09 発言
【38378】Re:テキストファイルの高速読込み aya 06/6/1(木) 10:23 質問
【38387】Re:テキストファイルの高速読込み neptune 06/6/1(木) 14:42 回答
【38389】Re:テキストファイルの高速読込み aya 06/6/1(木) 15:50 発言
【38391】Re:テキストファイルの高速読込み neptune 06/6/1(木) 17:54 回答
【38392】Re:テキストファイルの高速読込み neptune 06/6/1(木) 18:52 発言

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