人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

ExcelVBAで巨大なテキストファイル(ファイルサイズ7MB程、全角半角混在の改行無しのベタデータ)を読み込み、500文字で区切ってそれを1レコードとし、A1,A2・・・とセルを変えて文字列を貼り付けようとしています。
いかんせんファイルサイズが大きいために処理時間に大変時間がかかっています。
・処理の速いコード
・時間がかかるとして処理中にプログレスバー表示をするコード
をご呈示下さい。Excelのバージョンは2000-2007です。

●質問者: smileless
●カテゴリ:コンピュータ インターネット
✍キーワード:A1 Excel コード サイズ セル
○ 状態 :終了
└ 回答数 : 5/5件

▽最新の回答へ

1 ● AZUY
●5ポイント

http://www.asahi-net.or.jp/~ZN3Y-NGI/YNxv9g1810.html

◎質問者からの返答

ありがとうござます。

プログレスバーだけの回答についてはこれで終了とさせて下さい。

本当に質問内容が言葉足らずで申し訳ないです。

プログレスバーの表示はあくまでおまけで、本筋は巨大なファイルを読み込んで処理をするのに処理時間を短くするにはどうしたらよいか、でした。

具体的なコードを示し、ご教授いただきたいということろこですのでよろしくお願いいたします。

一応、

OFFICE TANAKA:VBA高速化テクニック

http://officetanaka.net/excel/vba/speed/index.htm

にあるようなテクニックは使用しているのですが、それでも遅いので、ファイルの読み方そのものに何か工夫があるのではないか?と質問させていただきました。

(逆にプログレスバー処理を入れることで遅くなるのであればそれは外そうともかんがえています)

よろしくお願いいたします。


2 ● Mook
●40ポイント

現在の「大変時間がかかっている」がどの程度か分かりませんが、

下記のようなコードでどうでしょうか。

Sub loadLargeFile()
 Const data_file = "C:\test.txt"
 Const temp_file = "C:\temp.csv"
 
 Dim fso As Object
 Set fso = CreateObject("Scripting.FileSystemObject")
 
 Data = fso.OpenTextFile(data_file).ReadAll()

 Dim dlen As Long, dpos As Long
 dlen = Len(Data)
 
 Dim outFile As Object
 Set outFile = fso.CreateTextFile(temp_file, True)
 For dpos = 1 To dlen Step 500
 outFile.WriteLine """" & Mid(Data, dpos, 500) & """"
 Next
 outFile.Close
 
 Workbooks.Open temp_file
End Sub

先頭のファイル情報を変更して、お試しください。

7Mでも数秒で終わるので、プログレスバーは実装しませんでした。


http://msdn.microsoft.com/ja-jp/library/cc428071.aspx

◎質問者からの返答

大変参考になりました。

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

やはり、いろいろなタイプのコードを見るのは勉強になりますね。


3 ● jccrh1
●20ポイント

以下の条件で対応しました。

・入力ファイルはEXCELと同一フォルダーに入っているものとしました。

・レコード数は14,000件にしました。

・データはすべて半角で対応しました。

処理速度は私のPC(EXCEL2003,VISTA,CPU=P8600)で8?9秒でした。

Option Explicit

Sub 入力処理()
 Const レコード長 = 500
 Dim レコード数 As Long
 Dim レコード As String * レコード長
 Dim I As Long
 Dim 進捗率 As Integer
 
 Open ThisWorkbook.Path & "\TEST.TXT" For Random As #1 Len = レコード長
 レコード数 = (LOF(1) / レコード長)
 
 For I = 1 To レコード数
 進捗率 = I * 10 / レコード数
 Application.StatusBar = String(進捗率, "■") & String(10 - 進捗率, "□")
 Get #1, I, レコード
 Range("A1").Offset(I - 1).NumberFormatLocal = "@"
 Range("A1").Offset(I - 1).Value = レコード
 Next I
 
 Close
 Application.StatusBar = False
End Sub

ダミーURL

http://www.hatena.ne.jp/

◎質問者からの返答

ありがとうございます。

お手製のステータスバーが非常にいい感じです。(できればコントロールを使いたくないので)

これって、Application.ScreenUpdating = Falseと併用はできるのでしょうか、ちょっと試してみます。

全角混在だとやはりユニコードでmidするしかないのでしょうか。


4 ● jccrh1
●20ポイント

先ほどの変更で全角も対応してあります。

> Application.ScreenUpdating = False

これについては、今回全く影響はないので、命令を追加しても意味がないと思います。

Option Explicit
 
Sub 入力処理_全角OK()
 Const レコード長 = 500
 Dim レコード数  As Long
 Dim レコード(レコード長 - 1) As Byte
 Dim I As Long
 Dim 進捗率 As Integer
 
 Open ThisWorkbook.Path & "\TEST.TXT" For Binary As #1
 レコード数 = (LOF(1) / レコード長)
 
 For I = 1 To レコード数
 進捗率 = I * 10 / レコード数
 Application.StatusBar = String(進捗率, "■") & String(10 - 進捗率, "□")
 Get #1, , レコード
 Range("A1").Offset(I - 1).NumberFormatLocal = "@"
 Range("A1").Offset(I - 1).Value = StrConv(レコード, vbUnicode)
 Next I
 
 Close
 Application.StatusBar = False
End Sub

ダミーURL

http://www.hatena.ne.jp/

◎質問者からの返答

ありがとうございます。


5 ● rolexbaidu
●15ポイント

http://www.lv-google.net/E-gc9.htm

◎質問者からの返答

あー、はてなもこんな回答がつくようになりましたか・・・

誤爆かな?であればかまわないのですが・・

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ