VBA プログラム実行処理時間について

質問

大変、お世話になっております。

以下のプログラムを作成しました所、処理時間が25、6秒程かかりました。
プログラムを訂正し、処理時間の速度を上げる方法はないでしょうか？
宜しくおねがいします。

※処理は、添付画像の「CSV読込」ボタンで、カンマ区切りの「test.CSV」ファイルを自動で「CSV⇒Collectionサンプル.xlsm」の「CSV読込」Sheetへ流し込みます。また、G2セルのキー（果物）データをKEYにしてヒットした小計値をH2から下方向へヒット数分転記します。

＜動作環境＞

Windows10（64bit）、Excel2016（32bit）

CPU：Intel Core i7 7500U @ 2.70GHz Kaby Lake-U/Y 14nm Technology
RAM：16.0GB

＜VBA－標準モジュール＞

Option Explicit

Sub CSV読込_ボタン()
Dim file As String: file = ThisWorkbook.Path & "\test.csv" 'CSVファイル指定
Dim Items As New Collection 'コレクションを生成
Dim Start, Finish, TotalTime As Single '処理時間
Dim i, j As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Call DataClearFunc(1)
Call ClearImmediate

Start = Timer() ' 処理開始時刻を設定します。

Open file For Input As #1 'CSVファイルを開く
Do Until EOF(1) '最終行までループ
Dim buf As String: Line Input #1, buf '読み込んだデータを1行ずつみていく
Dim tmp As Variant: tmp = Split(buf, ",") 'カンマで分割

With New Class1 'インスタンスの生成
.Name = CStr(tmp(0)) '果物
.Price = CInt(tmp(1)) '単価
.Number = CInt(tmp(2)) '個数
Items.Add .Self 'コレクションに追加
End With
Loop
Close #1 'CSVファイルを閉じる

Dim item As Class1 'ループ用の変数
With ActiveSheet
i = 2: j = 2
.Range("A1").Value = "果物": .Range("B1").Value = "単価": .Range("C1").Value = "個数": _
.Range("D1").Value = "小計": .Range("G1").Value = "キー（果物）": .Range("H1").Value = "小計"
For Each item In Items 'コレクション内をループ
' Debug.Print item.Name, item.Price, item.Number, item.Sale 'プロパティを取得
.Range("A" & i).Value = item.Name: .Range("B" & i).Value = item.Price: _
.Range("C" & i).Value = item.Number: .Range("D" & i).Value = item.Sale
If item.Name = .Range("G2").Value Then .Range("H" & j).Value = item.Sale: j = j + 1 'キーで要素取得・取出し
i = i + 1
Next
End With
Debug.Print Items(3).Name '要素取出し

Application.DisplayAlerts = True
Application.ScreenUpdating = True

Finish = Timer() ' 処理終了時刻を設定します。
TotalTime = Finish - Start ' 実際の処理時間を計算します。
MsgBox "処理時間は " & TotalTime & " 秒でした。"
End Sub

Sub データクリア_ボタン()
' Call ClearImmediate
Call DataClearFunc(1)
ActiveSheet.Range("A2").Select
End Sub

Sub DataClearFunc(Key As Long)
Dim i, j, MaxRow As Long
With ActiveSheet
MaxRow = .Range("A2").End(xlDown).Row
If Key Then
.Range("A2" & ":D" & MaxRow).Clear: .Range("H2" & ":H" & MaxRow).Clear
Else
.Range("A2" & ":D" & MaxRow).Clear
End If
End With
End Sub

Public Sub ClearImmediate()
Dim i As Long
Dim CP, wd As VBIDE.Window

With Application.VBE
Set CP = .ActiveWindow
Set wd = .Windows("イミディエイト")
.Windows("イミディエイト").Visible = True
' CP.SetFocus
Application.SendKeys "^g", False
Application.SendKeys "^a", False
Application.SendKeys "{Del}", False
End With

End Sub

＜VBAークラスモジュール＞

Option Explicit

Public Name As String '果物(Name)プロパティ
Public Price As Integer '単価(Price)プロパティ
Public Number As Integer '個数(Number)プロパティ

'Saleプロパティは取得のみ
Property Get Sale() As Integer
Sale = Price * Number '単価×個数の値を使う
End Property

Public Property Get Self() As Class1
Set Self = Me
End Property

回答No.2

f272 · ベストアンサー

私が適当なcsvファイルを作って実行させたところ3.87秒かかった。
なお'Call ClearImmediateはコメントにした。

-----------------------------------------
次に
Start = Timer() ' 処理開始時刻を設定します。
から
Finish = Timer() ' 処理終了時刻を設定します。
の間を，以下のように書き換えたら0.28秒になった。
-----------------------------------------
Open file For Input As #1 'CSVファイルを開く
n = 0
Do Until EOF(1) '最終行までループ
Dim buf As String: Line Input #1, buf '読み込んだデータを1行ずつみていく
n = n + 1
Dim tmp As Variant: tmp = Split(buf, ",") 'カンマで分割

With New Class1 'インスタンスの生成
.Name = CStr(tmp(0)) '果物
.Price = CInt(tmp(1)) '単価
.Number = CInt(tmp(2)) '個数
Items.Add .Self 'コレクションに追加
End With
Loop
Close #1 'CSVファイルを閉じる

Dim item As Class1 'ループ用の変数
With ActiveSheet
i = 1: j = 1
.Range("A1").Value = "果物": .Range("B1").Value = "単価": .Range("C1").Value = "個数": _
.Range("D1").Value = "小計": .Range("G1").Value = "キー（果物）": .Range("H1").Value = "小計"

ReDim aa(1 To n + 1, 1 To 4)
ReDim bb(1 To n, 1 To 1)
Dim Key As String
Key = .Range("G2").Value
For Each item In Items 'コレクション内をループ
' Debug.Print item.Name, item.Price, item.Number, item.Sale 'プロパティを取得
aa(i, 1) = item.Name: aa(i, 2) = item.Price: _
aa(i, 3) = item.Number: aa(i, 4) = item.Sale
If item.Name = Key Then bb(j, 1) = item.Sale: j = j + 1 'キーで要素取得・取出し
i = i + 1
Next

.Range("A2").Resize(n, 4) = aa
.Range("H2").Resize(j, 1) = bb

End With
Debug.Print Items(3).Name '要素取出し

Application.DisplayAlerts = True
Application.ScreenUpdating = True

-----------------------------------------
さらに
Start = Timer() ' 処理開始時刻を設定します。
から
Finish = Timer() ' 処理終了時刻を設定します。
の間を，以下のように書き換えたら0.22秒になった。
-----------------------------------------
Open file For Input As #1 'CSVファイルを開く
Dim buf As String
Dim Key As String
Dim tmp As Variant
n = 0
Do Until EOF(1) '最終行までループ
Line Input #1, buf '読み込んだデータを1行ずつみていく
n = n + 1
Loop

ReDim aa(1 To n, 1 To 4)
ReDim bb(1 To n, 1 To 1)
Key = ActiveSheet.Range("G2").Value
i = 1: j = 1
Seek #1, 1
Do Until EOF(1) '最終行までループ
Line Input #1, buf '読み込んだデータを1行ずつみていく
tmp = Split(buf, ",") 'カンマで分割
aa(i, 1) = CStr(tmp(0)) '果物
aa(i, 2) = CInt(tmp(1)) '単価
aa(i, 3) = CInt(tmp(2)) '個数
aa(i, 4) = aa(i, 2) * aa(i, 3)
If aa(i, 1) = Key Then bb(j, 1) = aa(i, 4): j = j + 1 'キーで要素取得・取出し
i = i + 1
Loop
Close #1 'CSVファイルを閉じる

With ActiveSheet
.Range("A1").Value = "果物": .Range("B1").Value = "単価": .Range("C1").Value = "個数": _
.Range("D1").Value = "小計": .Range("G1").Value = "キー（果物）": .Range("H1").Value = "小計"

.Range("A2").Resize(n, 4) = aa
.Range("H2").Resize(j, 1) = bb

End With
Debug.Print aa(3, 1) '要素取出し

Application.DisplayAlerts = True
Application.ScreenUpdating = True

お礼

２次元配列を使うのですね！
ソースコードまで付けて下さって、本当にありがとうございます。
5000件のCSVデータを処理した所、25秒以上かかっていましたが、Collection処理を追加しても0.5秒以内に収まりました。

回答No.1

kon555

ザッと拝見したところ、ループ処理で毎回セルに値を入れているようなので、「値を配列に入れてからセルに代入する」で高速化できるのではないかと思います。
以下参考ページ
http://officetanaka.net/excel/vba/speed/s11.htm
https://excel-ubara.com/excelvba1/EXCELVBA414.html
https://mmm-program.com/vba-fast-array/

お礼

やはり配列を使うのですね！
ありがとうございます。
頑張ります。