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
お礼
ご回答を頂いた皆様 今回は貴重なお時間を割いてたくさんのアドバイスをいただきまして、 本当にありがとうございました。 特にご回答を頂いた皆様からのアドバイスは、 凝り固まっていた自分の発想の転換になり、 アイディアが湧いてくるようになりました。 皆様がいなかったら、投げ出していたかもしれません。 ご相談させいただけて助かりました。 私の成長を期待していてください。 これからも、ご指導の程、よろしくお願いいたします。 今回は貴重なご回答ありがとうございました。 質問者