SELECTED ENTRIES
RECENT COMMENTS
CATEGORIES
ARCHIVES
MOBILE
qrcode
PROFILE
OTHERS

04
--
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
--
>>
<<
--

二律背反

反省はするけど、後悔はしないプログラマー。
日々の雑記など。
<< 半年 | main |
VBA でファイルを高速に読み込む
VBA でファイルを読む込む時は Open 関数と Input を使うのが基本ですが、これだとあまりにも処理速度が遅すぎるため 100 万レコードクラスのデータを扱う場合には不向きとされています。
というか、これは楽なコードで楽をしようとしてるのが悪いわけで…。
ファイルを開くということがどういうことかをきちんと分かっていれば、C++ などでファイル操作するのと同等の処理速度で処理をすることができます。
まぁ、偉そうなことを言っていますがバイナリアクセスするだけなんですけどね。

ファイルのパスと、結果を受け取る配列を用意して呼び出すだけです。
読んだ件数などは Ubound() 関数などを使ってみてください。
Dim str_file_path              As String ' 保存用ファイルのパス
Dim str_result_specification() As String ' ファイルの抽出結果格納用テンポラリ

    Call ReadData(str_file_path, str_result_specification)


標準モジュールにコピペ
Option Explicit
' ### 定数宣言 ################################################
Const RETRY_MAX                    As Integer = 5 ' ファイルを読み込む際のリトライ回数


Function ReadData(str_file_path As String, _
                       str_result_specification()
As String, _
                       Optional int_count As Long = 1) As Boolean
    ReadData = False

    On Error GoTo err:

   
Dim intFF            As Long    ' open 関数用ファイルポインタ
   
Dim byt_buf()        As Byte    ' binary 読み込み用テンポラリ
   
Dim str_unicode      As String  ' Unicode 保管用テンポラリ
   
Dim var_line_data    As Variant ' 取得データ
   
Dim var_buf          As Variant ' 改行コード区切りの配列テンポラリ
   
Dim lng_item_max     As Long    ' for 関数用テンポラリ
   
Dim lng_result_count As Long

    ' ### 初期化 ##############################################
    err.Clear                                  ' エラーコード
    str_unicode = ""                           ' 文字コード変換用バッファ
    lng_result_count = 0
    ReDim Preserve str_result_specification(0) ' 結果用配列

    ' ### 読み込み処理 ########################################
    
    intFF = FreeFile
    Open str_file_path For Binary Lock Read As #intFF 
' ファイルを開く[バイナリモード/ロック]

    Do
        If GetInputState() Then DoEvents
        
        ' メモリ対策でファイルを分割して読み込む
        ReDim byt_buf(LOF(intFF) ¥ 2 ^ int_count)
        Get #intFF, , byt_buf

        var_buf = Split(str_unicode & StrConv(byt_buf(), vbUnicode), vbLf) '改行コードごとに区切って配列化

        ' 文字列として抽出できたものを配列に格納する
        lng_item_max = UBound(var_buf)
        ReDim Preserve str_result_specification(UBound(str_result_specification) + lng_item_max + 1)
        
        For Each var_line_data In var_buf
            str_result_specification(lng_result_count) = var_line_data
            lng_result_count = lng_result_count + 1
        Next
        
        var_line_data = Null

        ' 残ったデータは次の解析に回す
        str_unicode = var_buf(lng_item_max)
    Loop While Not EOF(intFF)

    ReDim Preserve str_result_specification(lng_result_count)

err:
    Close #intFF 
' ファイルを閉じる

    ' ### 終了処理 ############################################
    var_buf = Null
    str_unicode = ""
    Erase byt_buf

    ' ### エラー処理 ##########################################
    ' ・メモリが不足しています。(7)
    ' ・文字列領域が不足しています。(14)
    ' が発生した場合は、RETRY_MAX に指定した値まで繰り返す

    Select Case err.Number
        Case 7, 14
            ReDim Preserve str_result_specification(0)
            err.Clear ' 再起処理を行う前に、エラー情報を削除する

            ' 読み込みメモリの分割数を累乗しながら指定回数繰り返す
            ' 2 -> 4 -> 8 -> 16 -> 32

            If (int_count < RETRY_MAX) Then
                ' 再帰処理
                ReadData = ReadData(str_file_path, str_result_specification, int_count + 1)
            End If
        Case 0
            ReadData = True
    End Select
End Function
| 技術 | 00:00 | comments(0) | - |