| |
フォルダ内保存されているテキストファイルを読み込んでシートに書込みする処理を行っています。
処理速度が遅く、だいたい１レコードに１秒かかってしまい、大量のデータを処理する時にはイライラします。
自分で作ったコードを利用しながら、高速読込みを実現したいですがどうすればいいかわからず、どなたかお力を貸していただきたいと思い書込みしました。
初心者でコードにまとまりもなく、わかりづらいとは思います。すいません。
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
また料金が表示されている箇所には「△」が入っていることがあり、これはマイナスの金額になりますので、シートに書き込む際には「△」を削除し文字色を赤にしています。
どなたかアドバイスいただけませんか？
よろしくお願いします。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
