Excel VBA質問箱 IV

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

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


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

【51766】テキストファイルを高速で読み込む ノリ 07/10/4(木) 7:20 質問[未読]
【51768】Re:テキストファイルを高速で読み込む ちん 07/10/4(木) 7:55 発言[未読]
【51769】Re:テキストファイルを高速で読み込む ハチ 07/10/4(木) 9:29 発言[未読]
【51800】Re:テキストファイルを高速で読み込む ノリ 07/10/5(金) 8:07 お礼[未読]
【51899】Re:テキストファイルを高速で読み込む Jaka 07/10/10(水) 9:31 発言[未読]
【51906】Re:テキストファイルを高速で読み込む Hirofumi 07/10/10(水) 19:09 回答[未読]
【51909】Re:テキストファイルを高速で読み込む Hirofumi 07/10/10(水) 20:43 発言[未読]
【51910】Re:テキストファイルを高速で読み込む Hirofumi 07/10/10(水) 20:52 発言[未読]

【51766】テキストファイルを高速で読み込む
質問  ノリ  - 07/10/4(木) 7:20 -

引用なし
パスワード
   はじめまして。

以下のようにテキストファイルの内容をワークシート内に写すマクロを作成しました。

Option Explicit
Sub TextRead()
  Const name = "C:\test.log"
  Dim intFF As Integer      ' FreeFile値
  Dim r As Long        
  Dim strREC As String 
  
  intFF = FreeFile
 
  Open name For Input As #intFF
  r = 1
  
  Do Until EOF(intFF)
    
    Line Input #intFF, strREC 
    Cells(r, 1).Value = strREC
    r = r + 1 
  Loop
 
  Close #intFF
End Sub


このコードで実行はできるのですが、いかんせん読み込むファイルが
行にすると約3000行、600KB近くあるので
仕事場で使用しているノートPCがあまり高スペックとはいえない為、
読み込む速度は1度に約5〜6分で最悪フリーズしてしまうこともあります。

画面表示をさせないコードを入れてみたりしたのですが
実行速度はあまり変わらず。


もし、もっと高速でCPUに負担の少ないコードが作れるのであれば
是非教えていただきたいです。

条件としては、
・テキストファイル内の1行ずつを読み、シート内の1つずつのセルに格納する。

ことのみです。


無知な故、お恥ずかしい限りではございますが
ご教授の程よろしくお願いいたします。

【51768】Re:テキストファイルを高速で読み込む
発言  ちん  - 07/10/4(木) 7:55 -

引用なし
パスワード
   おはようございます。ちんといいます。

考えられることとしては、
・EXCELの非表示設定が記述されてない。
・特殊文字がデータ内に混じってる?(Unicodeも含め)

試しに、CSV読込を実行してみて下さい。(5分くらいかかるのか?)
TEST.log -> TEST.csv に変更し、EXCELの開くからCSV読込して
どのくらいのスピードか?

以上、

【51769】Re:テキストファイルを高速で読み込む
発言  ハチ  - 07/10/4(木) 9:29 -

引用なし
パスワード
   ▼ノリ さん:
>はじめまして。
>
>以下のようにテキストファイルの内容をワークシート内に写すマクロを作成しました。
>
>Option Explicit
>Sub TextRead()
>  Const name = "C:\test.log"
>  Dim intFF As Integer      ' FreeFile値
>  Dim r As Long        
>  Dim strREC As String 
>  
>  intFF = FreeFile
> 
>  Open name For Input As #intFF
>  r = 1
>  
>  Do Until EOF(intFF)
>    
>    Line Input #intFF, strREC 
>    Cells(r, 1).Value = strREC
>    r = r + 1 
>  Loop
> 
>  Close #intFF
>End Sub
>
>
>このコードで実行はできるのですが、いかんせん読み込むファイルが
>行にすると約3000行、600KB近くあるので
>仕事場で使用しているノートPCがあまり高スペックとはいえない為、
>読み込む速度は1度に約5〜6分で最悪フリーズしてしまうこともあります。
>
>画面表示をさせないコードを入れてみたりしたのですが
>実行速度はあまり変わらず。
>
>
>もし、もっと高速でCPUに負担の少ないコードが作れるのであれば
>是非教えていただきたいです。
>
>条件としては、
>・テキストファイル内の1行ずつを読み、シート内の1つずつのセルに格納する。
>
>ことのみです。
>
>
>無知な故、お恥ずかしい限りではございますが
>ご教授の程よろしくお願いいたします。

3000行程度で、5,6分もかかるというのは遅すぎですね・・・
ReadAllで読み込んで一気に書き出すと少し早くなるかもしれませんが、
PCのスペックが低いと 逆に遅くなるかも。

↓のあたりはチェックしてみましたか?

・関数の再計算がされている
・Worksheetのイベントを設定している

【51800】Re:テキストファイルを高速で読み込む
お礼  ノリ  - 07/10/5(金) 8:07 -

引用なし
パスワード
   ちんさん、ハチさん、ご回答ありがとうございます。
お返事が遅くなってしまい申し訳ございません。


問題のPCですが、午前中は調子がよく読みこむのに2分少々。
しかしどうも熱暴走しやすいらしく、
午後になると5分・・・あるいはフリーズしてしまいます。。。。

なんだかこればっかりは仕方ないような気がしてきました。

ちんさん、ハチさんにアドバイスいただいたことを昨日の職場で
ちょっとやってみましたがどうも改善はみられません(笑)

自分の能力足らずでお二人に申し訳なく思ってます。
ありがとうございました。

【51899】Re:テキストファイルを高速で読み込む
発言  Jaka  - 07/10/10(水) 9:31 -

引用なし
パスワード
   すみません。
不覚にも気づかずに提示されたコードをそのまま使ってしまいました。
1部修正して、そのまま同じものを再アップ。
前のコードをそのまま利用すると、
「なぜ私のPCだけ? Why?」ってな事になります。

予約語を変数やプロシジャー名に使うと上記のようなことになったりするし、誤動作する場合があるかもも知れないので止めましょう。

MsgBox ActiveSheet.Name  .Nameとならずに.nameになる場合も...。
直し方を知っていたり、気にしなければ良いですけど。

で、修正点
Const name → Const name_1

以下前のまま。

遅い原因は、これ。
Cells(r, 1).Value = strREC
1行読んでは書き込む、と言った感じで1行づつ処理しているからです。
ある程度配列に溜め込んでから書き出すようにすると、現状よりかなり速くなりますよ。

注)
Preserveしながら、1行づつ配列を拡張しても良いですが、1次元配列だから書き込み時にTransposeさせないといけません。
Transposeできる配列の要素数の上限が、5461個までそれ以上になるとエラーになります。


  Const name_1 = "C:\test.log"
  Dim intFF As Integer      ' FreeFile値
  Dim r As Long
  Dim strREC As String
  Dim 配列() As String
  intFF = FreeFile
 
  Open name_1 For Input As #intFF
 
  Do Until EOF(intFF)
    Line Input #intFF, strREC
    r = 1 + r
    ReDim Preserve 配列(1 To 1, 1 To r)
    配列(1, r) = strREC
  Loop
  Range("A1").Resize(UBound(配列, 2)).Value = Application.Transpose(配列)
  Close #intFF
  Erase 配列


他、だいぶ前に書いた奴。
コードが長すぎて、参考にはならないと思いますが。
HTTP://www.vbalab.net/vbaqa/data/excel/log/tree_373.htm#1910

コピペする場合の注意点
HTTP://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=1464;id=


>仕事場で使用しているノートPCがあまり高スペックとはいえない為、
>読み込む速度は1度に約5〜6分で最悪フリーズしてしまうこともあります。
現時点(2007/10現在)で、「あまり高スペックとはいえない」となると結構なスペックだと思います。
参考まで、現在のPCスペック10年ぐらい前の K6-2 の500MHz/256MB。

【51906】Re:テキストファイルを高速で読み込む
回答  Hirofumi  - 07/10/10(水) 19:09 -

引用なし
パスワード
   大分前に作った物ですが?
設定した行数分づつ読み込みます

  '1回にシート出力する行数(この取り方で多少変化有り)
  Const clngRows As Long = 1000

の値で負荷が変わりますので、色々試して下さい

Option Explicit

Public Sub Sample()

  '1回にシート出力する行数(この取り方で多少変化有り)
  Const clngRows As Long = 1000

  Dim i As Long
  Dim lngRow As Long
  Dim rngResult As Range
  Dim strResult() As String
  Dim dfn As Integer
  Dim vntFileName As Variant
  Dim strBuff As String
  Dim strProm As String
  
  If Not GetReadFile(vntFileName, ThisWorkbook.Path & "\TestData", False) Then
    strProm = "マクロがキャンセルされました"
    GoTo Wayout
  End If
  
  '画面更新を停止
  Application.ScreenUpdating = False
  
  '出力Listの左上隅セル位置を基準として設定
  Set rngResult = ActiveSheet.Cells(1, "A")
  
  dfn = FreeFile
  Open vntFileName For Input As dfn
  
  ReDim strResult(1 To clngRows, 1 To 1)
  Do Until EOF(dfn)
    Line Input #dfn, strBuff
    i = i + 1
    strResult(i, 1) = strBuff
    If i = clngRows Or EOF(dfn) Then
      rngResult.Offset(lngRow).Resize(i).Value = strResult
      lngRow = lngRow + i
      i = 0
      ReDim strResult(1 To clngRows, 1 To 1)
    End If
  Loop
  
  Close #dfn
  
  strProm = "処理が完了しました"
  
Wayout:
  
  '画面更新を再開
  Application.ScreenUpdating = True
  
  Set rngResult = Nothing
  
  MsgBox strProm , vbInformation
  
End Sub

Private Function GetReadFile(vntFileNames As Variant, _
            Optional strFilePath As String, _
            Optional blnMultiSel As Boolean _
                    = False) As Boolean

  Dim strFilter As String
  
  'フィルタ文字列を作成
  strFilter = "CSV File (*.csv),*.csv," _
        & "Text File (*.txt),*.txt," _
        & "Print File (*.prn),*.prn," _
        & "CSV and Text (*.csv; *.txt),*.csv;*.txt," _
        & "全て (*.*),*.*"
  '読み込むファイルの有るフォルダを指定
  If strFilePath <> "" Then
    'ファイルを開くダイアログ表示ホルダに移動
    ChDrive Left(strFilePath, 1)
    ChDir strFilePath
  End If
  'もし、ディフォルトのファイル名が有る場合
  If vntFileNames <> "" Then
    SendKeys vntFileNames & "{TAB}", False
  End If
  '「ファイルを開く」ダイアログを表示
  vntFileNames _
      = Application.GetOpenFilename(strFilter, 3, , , blnMultiSel)
  If VarType(vntFileNames) = vbBoolean Then
    Exit Function
  End If
  
  GetReadFile = True
  
End Function

【51909】Re:テキストファイルを高速で読み込む
発言  Hirofumi  - 07/10/10(水) 20:43 -

引用なし
パスワード
   蛇足ですが?

>問題のPCですが、午前中は調子がよく読みこむのに2分少々。
>しかしどうも熱暴走しやすいらしく、
>午後になると5分・・・あるいはフリーズしてしまいます。。。。

相当古いPCか、メモリの量が少ないのですか?
ちなみに、私のPCも相当古いもので、Win98(無印)、Excel97、
ペンティアムIII600MHz、メモリ256MBですが?

約3200行、700MBのファイルを
質問のコードで、約2.7秒
私のコードで、約0.3秒で読み込む様ですよ?

【51910】Re:テキストファイルを高速で読み込む
発言  Hirofumi  - 07/10/10(水) 20:52 -

引用なし
パスワード
   ごめん、

「約3200行、700MBのファイルを」



「約3200行、700KBのファイルを」

の間違いです

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