Excel VBA質問箱 IV

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

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


43538 / 76735 ←次へ | 前へ→

【38244】Re:テキストファイルの高速読込み
回答    - 06/5/30(火) 15:44 -

引用なし
パスワード
   とりあえず

Application.ScreenUpdating = false
として、画面更新を止めましょう。


▼aya さん:
>フォルダ内保存されているテキストファイルを読み込んでシートに書込みする処理を行っています。
>処理速度が遅く、だいたい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
>
>また料金が表示されている箇所には「△」が入っていることがあり、これはマイナスの金額になりますので、シートに書き込む際には「△」を削除し文字色を赤にしています。
>
>どなたかアドバイスいただけませんか?
>よろしくお願いします。
0 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 発言

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