| |
とりあえず
Application.ScreenUpdating = false
として、画面更新を止めましょう。
▼aya さん：
>フォルダ内保存されているテキストファイルを読み込んでシートに書込みする処理を行っています。
>処理速度が遅く、だいたい１レコードに１秒かかってしまい、大量のデータを処理する時にはイライラします。
>自分で作ったコードを利用しながら、高速読込みを実現したいですがどうすればいいかわからず、どなたかお力を貸していただきたいと思い書込みしました。
>初心者でコードにまとまりもなく、わかりづらいとは思います。すいません。
>
>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 & "_
> レコード目)"
> 'データを１行単位で読み込んで変数「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日の日付になるようつじつまを合わせています。
>もっといい方法があるのでしょうけど･･･
>
>テキストファイルの中身は下記の通りの固定長で、１レコード１行です。
>不必要なデータが入っているので途中で処理をして必要なデータだけ抜き出しています。
>
>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
>
>また料金が表示されている箇所には「△」が入っていることがあり、これはマイナスの金額になりますので、シートに書き込む際には「△」を削除し文字色を赤にしています。
>
>どなたかアドバイスいただけませんか？
>よろしくお願いします。
|
|
Ｔ
- 06/5/30(火) 15:44 -
