Excel VBA質問箱 IV

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

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


7542 / 13644 ツリー ←次へ | 前へ→

【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 発言[未読]

【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

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

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

【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
>
>また料金が表示されている箇所には「△」が入っていることがあり、これはマイナスの金額になりますので、シートに書き込む際には「△」を削除し文字色を赤にしています。
>
>どなたかアドバイスいただけませんか?
>よろしくお願いします。

【38245】Re:テキストファイルの高速読込み
発言  aya  - 06/5/30(火) 15:55 -

引用なし
パスワード
   ▼T さん:

言い忘れていましたが、このコードはサブルーチンですので親プロシージャーでは

Application.ScreenUpdating = false

の処理は行っていますので画面更新はもちろんとまっています。

【38246】Re:テキストファイルの高速読込み
発言  Jaka  - 06/5/30(火) 16:00 -

引用なし
パスワード
   >        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       'カウントをインクリメント
ぱっと見ですが...。
何で添え字の変化する配列に入れているのでしょうか?

せっかく配列に入れたのに、1個1個セルに値を入れているから余計に遅いんです。
2次元配列ならこんな感じで1活で入れられます。(列数が増たら応じて、複数回に分けて入れる。)

Dim Tb(1 To 20000, 1 To 1)
For i = 1 To 20000
  Tb(i, 1) = i
Next
Range("A1").Resize(UBound(Tb)).Value = Tb
Erase Tb

表示形式等は書き込んだ後でいいんじゃないかと....。

【38247】Re:テキストファイルの高速読込み
発言  Jaka  - 06/5/30(火) 16:07 -

引用なし
パスワード
   なんかトンチンカンくさいので、
行単一括の場合

Dim Tb() As Variant
For ii = 1 To 500
  ReDim Tb(1 To 256)
  For i = 1 To 256
    Tb(i) = i
  Next
  Cells(ii, 1).Resize(, UBound(Tb)).Value = Tb
Next
Erase Tb

【38249】Re:テキストファイルの高速読込み
発言  Kein  - 06/5/30(火) 16:13 -

引用なし
パスワード
   ひとつの考え方として、まず GetOpenFilename を MultiSelect:=True
で出して複数のテキストを選択可能にする。選択したファイルをループし、
コマンドプロンプトでテキスト結合する文字列を生成する。
結合したテキストを OpenTextメソッドで開いて、必要なデータをフィルターや
FindメソッドやMatch関数による検索で抽出し、Sheet2に転記する、
という方法があります。

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

引用なし
パスワード
   固定長ファイルなので読み込み自体はランダムアクセスの方が早いはずです。
以下手持ちのサンプル・・・多分動いたと思います。
小さいサイズなら、簡易DBとしてこのようなやり方で十分使えます。

Type TYPREC   '自分の環境に合うように変更必用
 fld1 As String * 8
 fld2 As String * 8
 FLD3 As String * 8
 FLD4 As String * 10
End Type

Sub ReadTest()
Dim strPath As String
Dim FNum As Long
Dim LastRec As Long, recNo As Long
Dim mRec As TYPREC

  FNum = FreeFile
  strPath = "C:\hoge\hoge.txt" 'ここは書き換えて
  Open strPath For Random As #FNum Len = Len(mRec)
  LastRec = LOF(FNum) \ Len(mRec)
  
  For recNo = 1 To LastRec
    Get #FNum, recNo, mRec
    With mRec
      Cells(recNo, 6).Value = .fld1
      Cells(recNo, 7).Value = .fld2
      Cells(recNo, 8).Value = .FLD3
      Cells(recNo, 9).Value = .FLD4
    End With
  Next recNo
  Close #FNum
End Sub

これより早く読み込みたいなら、バイナリアクセスで一気に全て読み込み
全て変数に格納、その後判断などの処理をしていく方法もあります。

【38268】Re:テキストファイルの高速読込み
発言  ichinose  - 06/5/30(火) 19:56 -

引用なし
パスワード
   ▼neptune さん:
こんばんは。
ちょっと気になったので・・・。

>固定長ファイルなので読み込み自体はランダムアクセスの方が早いはずです。

う〜ん、テキストファイルの順次読み込みは、
Line Inputを使用したほうが
ランダムアクセスよりわずかでも
速いと思いますけどねえ!!

例えば、

'========================================================
Type o_data
  f1 As String * 8
  f2 As String * 8
  f3 As String * 8
  f4 As String * 10
  f5 As String * 2 'Crlf格納用
  End Type
'================================================================
Sub mk_sample()
  Dim dat1 As o_data
  Dim idx As Long
  Open ThisWorkbook.Path & "\sample.txt" For Output As #1
  For idx = 1 To 400000
    With dat1
     .f1 = Format(idx, "00000000")
     .f2 = String(8, "a")
     .f3 = String(8, "b")
     .f4 = String(10, "c")
     
     Print #1, .f1 & .f2 & .f3 & .f4
     End With
    Next idx
  Close #1
End Sub

で固定長のテキストデータを400000件作成します。
尚、Thisworkbook.Pathを使っていますから、一度保存してから実行してください。


Test1

Line Inputで読み込み

'============================================================
Sub readtest1()
  Dim dat1 As String
  Dim idx As Long
  st = Now()
  Open ThisWorkbook.Path & "\sample.txt" For Input As #1
  Do Until EOF(1)
    Line Input #1, dat1
    Loop
  Close #1
  MsgBox Format(Now() - st, "hh:mm:ss") & "-----" & Mid(dat1, 1, 8)
End Sub


Test2
ランダムファイルに見立てて読み込み
'===============================================================
Sub readtest2()
  Dim dat1 As o_data
  Dim idx As Long
  Dim lastrec As Long
  st = Now()
  Open ThisWorkbook.Path & "\sample.txt" For Random As #1 Len = Len(dat1)
  lastrec = LOF(1) \ Len(dat1)
  For idx = 1 To lastrec
   Get #1, idx, dat1
   Next idx
  Close #1
  MsgBox Format(Now() - st, "hh:mm:ss") & "----" & dat1.f1
End Sub


Readtest1 Readtest2を実行してみてください。

私の環境でReadtest1 4秒  Readtest2 8秒
でした。


>
>これより早く読み込みたいなら、バイナリアクセスで一気に全て読み込み
>全て変数に格納、その後判断などの処理をしていく方法もあります。
これは、賛成ですが、全部読み込むとデータ量を気にしなくてななりませんから、
例えば、

1Kバイト分読み込んで処理

次の1Kバイト分読み込んで処理


というように
OSファイル管理の
バッファーとレコードの関係のようなアルゴリズムにすると
良いと思いますが・・・。

ただ、
ayaさんの問題は、ファイルの読み込みが問題ではなく、
読み込んでからの問題だと思いますけどねえ

Jakaさんの方法を一度、試してみてください。

【38287】Re:テキストファイルの高速読込み
発言  neptune  - 06/5/30(火) 23:10 -

引用なし
パスワード
   ▼ichinose さん:
>う〜ん、テキストファイルの順次読み込みは、
>Line Inputを使用したほうが
>ランダムアクセスよりわずかでも
>速いと思いますけどねえ!!
検証もせずに書きました。よく考えると順次読み込みに関しては、
検証してくださったichinose さんのおっしゃるとおりでしょう。
大変失礼しました。

バイト読み込みの方ですが、確かにファイルサイズよって処理速度は変化します。
ただ、私の経験では、10〜20MB程度までなら、ストレス無く読めます。
これ以上になると、分割しなければかえって遅くなりますが。

>OSファイル管理の
>バッファーとレコードの関係のようなアルゴリズムにすると
>良いと思いますが・・・。
これはやったことはありませんが、HDDを見に行く回数が増えますから
どうなんでしょう?関係ないのかな?
>バッファーとレコードの関係のようなアルゴリズム
はやはり優位なんでしょうかね?正解であるような気もしますが。

>ただ、
>ayaさんの問題は、ファイルの読み込みが問題ではなく、
>読み込んでからの問題だと思いますけどねえ
私もそう思います。
ただ、長いんで正直あまりソースは見てません。
経験上、1行ずつ読込んで1行ずつ判断処理するより、
一括読み込み→出力までの全ての判断、処理をメモリ上で行うという
手法のほうが、圧倒的に早かったと言うことはあります。
 で、一括読み込みを提案してみました。

所でこのスレにRes付けたの忘れてました。^ ^;;

Jakaさんの方法も見てみます。

ご指摘ありがとうございました。

【38288】Re:テキストファイルの高速読込み
発言  neptune  - 06/5/30(火) 23:20 -

引用なし
パスワード
   Jakaさんの方法みました。

かなり有効で、早くなると思います。

【38375】Re:テキストファイルの高速読込み
質問  aya  - 06/6/1(木) 9:59 -

引用なし
パスワード
   ▼Jaka さん:

最初に何も決めずに考えながらマクロを組んでいたのでなぜ配列に入れる処理を行うことをしていたのか忘れましたが、そこは必要ないと判断し削除しました。
すると1秒当たり3行処理できました。
しかしまだ遅いです。
一度に100件以上読み込む場合もありますので、表示するまでに2〜3分かかるのではないかと思われます。

ところでJaka さんが書いていただいた以下のマクロですが、どういった処理を行っているものなのでしょうか?
勉強不足ですいません。。。

>なんかトンチンカンくさいので、
>行単一括の場合
>
>Dim Tb() As Variant
>For ii = 1 To 500
>  ReDim Tb(1 To 256)
>  For i = 1 To 256
>    Tb(i) = i
>  Next
>  Cells(ii, 1).Resize(, UBound(Tb)).Value = Tb
>Next
>Erase Tb

頭の中では、一行ずつ読み込んでセルに取得した値をほうりこむのではなく、テキストファイルを全て読み込んでから処理して後で書き込むほうが速いとは思うのですが実現方法がわかりません。
とにかくJaka さんが書いていただいたマクロの意味を教えていただけませんか?
すいません。

【38376】Re:テキストファイルの高速読込み
発言  aya  - 06/6/1(木) 10:01 -

引用なし
パスワード
   ▼Kein さん:

勉強不足でおっしゃってる意味はなんとなくわかっても、それをどうやってマクロで実現するかは私にはわかりません。
確かに先に全部読み込んでから必要なデータを抜き出し、その後セルに書き込みという処理をするのが一番速いとは思ってはいるのですが・・・

>ひとつの考え方として、まず GetOpenFilename を MultiSelect:=True
>で出して複数のテキストを選択可能にする。選択したファイルをループし、
>コマンドプロンプトでテキスト結合する文字列を生成する。
>結合したテキストを OpenTextメソッドで開いて、必要なデータをフィルターや
>FindメソッドやMatch関数による検索で抽出し、Sheet2に転記する、
>という方法があります。

【38377】Re:テキストファイルの高速読込み
質問  aya  - 06/6/1(木) 10:16 -

引用なし
パスワード
   ▼ichinose さん:

初心者なものでせっかくichinose さんに書いてもらったマクロの内容が理解できません。
以下の部分は何をしているところなのでしょうか?
「固定長のテキストデータを400000件作成します」の意味がわからなくて・・・
すいません。。。
それと「ランダムファイルに見立てて読み取り」というところもわかりません。
私が使用した「Line Input」よりも処理は遅いみたいですが、メリットはあるのでしょうか?

確かにichinose さんのおっしゃるとおり、読み込んでからの処理が遅いのが原因だとは思うのですが、読み込んでから必要なデータを抜き出しセルに書き込む処理をする場合に速くする手段はあるのでしょうか?

質問ばかりになって申し訳ありません。
誰も教えてくれる人が周りにいなくて・・・
よろしくお願いします。

【38378】Re:テキストファイルの高速読込み
質問  aya  - 06/6/1(木) 10:23 -

引用なし
パスワード
   ▼neptune さん:

結構シンプルなマクロですので、理解した後に使えるかどうか考えてみます。
neptune さんのおっしゃるように

>これより早く読み込みたいなら、バイナリアクセスで一気に全て読み込み
>全て変数に格納、その後判断などの処理をしていく方法もあります。

これを実現できたらなとは思っていますが、どうすればいいかわかりません。
配列に1行ずつ読み込んで、その後処理をさせるという意味でしょうか?

1行の中には不必要なデータがたくさんありすぎて、処理が複雑になってしまっているのが現状です。
その処理をした後また配列に値を入れて、最後にセルに書き込みという処理を行う方が速いのでしょうか?

勉強不足で何もわからないので質問がわかりにくくなっていてすいません。
よろしくお願いします。

【38386】Re:テキストファイルの高速読込み
回答  Kein  - 06/6/1(木) 14:41 -

引用なし
パスワード
   Sub Mg_Text()
  Dim MyF As Variant, MyV As Variant
  Dim Ret As Long
  Dim FSO As Object
  Dim CmdSt As String, AllSt As String
  Const Ph As String = _
  "C:\Documents and Settings\User\My Documents"
 
  ChDir Ph
  With Application
   MyF = .GetOpenFilename("テキストファイル(*.txt),*.txt", _
   MultiSelect:=True)
   If VarType(MyF) = 11 Then Exit Sub
   .ScreenUpdating = False
  End With
  If Dir(Ph & "\Marge.txt") <> "" Then Kill Ph & "\Marge.txt"
  CmdSt = "CMD.EXE /C COPY "
  For Each MyV In MyF
   CmdSt = CmdSt & Dir(MyV) & "+"
  Next
  CmdSt = Left$(CmdSt, Len(CmdSt) - 1) & " Marge.txt"
  Ret = Shell(CmdSt, 2)
  With Application
   .Wait Time + TimeValue("00:00:01")
   .ScreenUpdating = True
   ChDir .DefaultFilePath
  End With
  If Ret = 0 Then
   MsgBox "COPYコマンドは失敗しました", 48: Exit Sub
  End If
  Set FSO = CreateObject("Scripting.FileSystemObject")
  With FSO.OpenTextFile(Ph & "\Marge.txt", 1)
   AllSt = .ReadAll
   .Close
  End With
  Set FSO = Nothing

  *ここに AllSt に対して InStr関数 などで特定の文字を検索し、
  それを基に何かの処理をするコードを書きます。

End Sub

【38387】Re:テキストファイルの高速読込み
回答  neptune  - 06/6/1(木) 14:42 -

引用なし
パスワード
   ▼aya さん:
最初にお詫びですが、aya さんの作業するファイルは恐らく固定長ファイル
ではありません。固定長ファイルには行という概念はありません。
1レコード(サイズ)で管理します。従って、1行ずつ読込むと
言うことはできません。
私の頭から抜けていたので、aya さんの説明とソースが違うと言うことに
気が付きませんでした。

>これを実現できたらなとは思っていますが、どうすればいいかわかりません。
お詫びに手持ちの関数をUPしときます。
Public Function ReadFile(psPath As String) As String
'//////////////////////////////////////////////////////
'ReadFile:該当するファイルのText全てを返す
'-------------------------------------
'引数
'psPath   :読み込むファイルのフルパス
'-------------------------------------
'戻り値:該当するファイルのText全てを返す。失敗時 "" を返す
'//////////////////////////////////////////////////////
Dim fnum As Long
Dim sPath As String
Dim sData As String
Dim fSize As Long
Dim bytBuf() As Byte

  On Error GoTo ErrorHandler
  sPath = psPath
  fSize = FileLen(sPath)
  ReDim bytBuf(fSize)
  fnum = FreeFile()
  Open sPath For Binary As #fnum
  Get #fnum, , bytBuf()
  Close #fnum
  
  sData = StrConv(bytBuf, vbUnicode)
  Erase bytBuf
  sData = Left(sData, InStr(1, sData, Chr(0)) - 1)
  ReadFile = sData
  
  Exit Function
ErrorHandler:
  Close
  ReadFile = ""
End Function

使い方
固定長ではなさそうなので改行毎に1行ずつに分解してます。
恐らくカンマ区切りのCSV形式では?
Sub t()
Dim sText As String
Dim sDatas() As String
  'sText に全てのテキストが返ってきます
  sText = ReadFile("D:\hoge\hoge.txt")
  'sDatas()に1行ごとに分割されます。
  sDatas = Split(sText, vbCrLf)  
End Sub

>配列に1行ずつ読み込んで、その後処理をさせるという意味でしょうか?
そうです。どうもカンマ区切りファイルのようですから、上の使い方のsDatas
の配列をそれぞれカンマ毎にもう一度分解したら、処理がやりやすくなる
(判断回数が減る)のではないですか?分解と言う処理は増えますけど。

>1行の中には不必要なデータがたくさんありすぎて、処理が複雑になってしまっているのが現状です。
>その処理をした後また配列に値を入れて、最後にセルに書き込みという処理を行う方が速いのでしょうか?
おそらくそう思います。

処理後、ぺたぺたとセルに貼り付けていくといいと思います。
但し、セルへのアクセスは最小限にしなければ効果は薄いです。
この辺はJakaさんのやり方を参考にしてください。

【38388】Re:テキストファイルの高速読込み
発言  Kein  - 06/6/1(木) 14:43 -

引用なし
パスワード
   > Const Ph As String = _
> "C:\Documents and Settings\User\My Documents"
の部分は、実際にテキストファイルを保存先しているフォルダーのパスにして下さい。

【38389】Re:テキストファイルの高速読込み
発言  aya  - 06/6/1(木) 15:50 -

引用なし
パスワード
   ▼neptune さん:

>ファイルは恐らく固定長ファイルではありません。固定長ファイルには行という概念はありません。
>1レコード(サイズ)で管理します。従って、1行ずつ読込むと言うことはできません。

とおっしゃっていますが、ファイルは間違いなく固定長でカンマ区切りではありません。
また色々調べましたが、固定長ファイルの場合でも行ごとに読み込んで処理をするとなっていました。
説明不足のところがあって誤解を招いているのであればすいません。
関数は確認させていただきます。
すぐに理解できないので使えるか考えてみます。

今の時点ではファイルの読込みに問題があるのではなく、その後の処理に問題があるとのことでしたので、ちょっと質問内容が変わってきましたので別スレを立てるつもりです。

【38391】Re:テキストファイルの高速読込み
回答  neptune  - 06/6/1(木) 17:54 -

引用なし
パスワード
   ▼aya さん:

>とおっしゃっていますが、ファイルは間違いなく固定長でカンマ区切りではありません。
>また色々調べましたが、固定長ファイルの場合でも行ごとに読み込んで処理をするとなって
>いました。
そうなんですか、ではそういう仕様なんでしょう。
1レコードの最終データに改行コードを定義している固定長フォーマットなんでしょうね。
そういうのもあるとは聞いたことはあるけど??

先ほどUPした関数は「最終データに改行コードを定義している固定長フォーマット」
なら、問題なく使えます。


別に言い張るつもりもありませんが、Windowsで普通、固定長ファイルと言うと、
例えば1レコード100バイトのレコード複数をファイルに
書き込んだTextです。その、レコードの中に改行を意味するキャラクタがあれば
その改行は有効ですが、レコードとレコードの間になんの区切りもありません。
ですから、メモ帳などのエディタで開いても、文字列は表示されますが、
数値だけのものですと、見た目にはどこからどこまでが1レコードなのかわかりません。


ちなみに
line input
は改行コードまでを順次読込むステートメントで、改行コードが区切りになって
いない、固定長ファイルでは使用しません。
Put,Getを使用します。Open ステートメントの[Len=reclength]引数は
固定長ファイルをランダムアクセスで読み書きするために使用します。

>今の時点ではファイルの読込みに問題があるのではなく、その後の処理に問題があると
>のことでしたので、ちょっと質問内容が変わってきましたので別スレを立てるつもりで
>す。
そうして下さい。
でもファイルサイズは知りませんが、大きくなると、その後の処理も含めて
倍近くは時間が違うような気もします。(もしかしたら程度です)
※Jakaさんの指摘が一番利くと思います。

【38392】Re:テキストファイルの高速読込み
発言  neptune  - 06/6/1(木) 18:52 -

引用なし
パスワード
   すみません。今気が付いたんですが、改行コードが
vbCrLfではない場合は、自分の環境に合わせて変更してください。
> 'sDatas()に1行ごとに分割されます。
>  sDatas = Split(sText, vbCrLf)

【38402】Re:テキストファイルの高速読込み
発言  ichinose  - 06/6/1(木) 23:09 -

引用なし
パスワード
   ▼aya さん:
こんばんは。

>以下の部分は何をしているところなのでしょうか?
>「固定長のテキストデータを400000件作成します」の意味がわからなくて・・・
>すいません。。。
ん、何がわからないのか、私にわかりません。

私が提示したコードは、新規ブックの標準モジュールにコピーしてください。
コピーした後、一度、適当なブック名で保存してください。


さて、ここからです。


提示したコードは、テキストファイルの順次読み込みを

Line Inputで行った場合とGetで読み込んだ場合との処理速度を
比較したものです。

そのために「mk_sample」というプロシジャーで

読み込むファイルをサンプルとして作成しています。
400000行のデータを作成しました。

このmk_sampleの実行によって作成されたファイルsample.txtを

プロシジャーreadtest1とreadtest2で違う方法で読み込んで
その速度を測定しています。(もっとも、ちょっと公平さを欠いたかもしれませんが)


>それと「ランダムファイルに見立てて読み取り」というところもわかりません。

readtest2では、36バイト(1行分の文字数+CRLFの合計に匹敵)を一回のGetで
読み込んでいます。

詳しいことは
ここは、HelpのOpenステートメントのランダムアクセスモードや
Getステートメントを調べてみてください。


>私が使用した「Line Input」よりも処理は遅いみたいですが、メリットはあるのでしょうか?
テキストデータの順次読み込みでの処理速度はLine Inputのほうが若干速いと思いますが、ランダムファイルの用途は色々とあります。
固定長のデータファイルですから、いきなり、50行目を取り出すこともできます。
又、読み込みと書き込みを同時に行うことも出来るという利点もあります。

DOSの時代には、シーケンシャルファイルとこのランダムファイルを使って、
販売管理システムのデータベースファイルをとして使ったこともありましたよ!!
もっとも最近は、あまり使われませんけどねえ!!

>確かにichinose さんのおっしゃるとおり、読み込んでからの処理が遅いのが原因だとは思うのですが、読み込んでから必要なデータを抜き出しセルに書き込む処理をする場合に速くする手段はあるのでしょうか?

ですから、Jakaさんの投稿をよく調べてみてください。

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