エクセルVBAの処理速度アップについて

質問

以下のエクセルVBAを組んでいるのですが、処理の速度をあげたいです。
無駄な記述があると思うのですが、調べても試行錯誤しても、上手くいきません。
処理速度をあげる記述をご教示願います。よろしくお願い申し上げます。

※別ファイルのAccessファイルをデータベースとして、「今年」テーブルと、「前年」テーブルそれぞれから条件抽出して、受注数量を合計させるものです。
※SQLのVBAです。なお、実際ファイルのVBAは、以下記述の５倍量あります（内容は、セル範囲が違うだけで同じ。現在速度：約３０秒）。
※「配列」というのを活用すれば速くなるようなのですが、理解できませんでした。。。
ーーーー【以下、VBA】－－－－－－－－－－－
Sub DSUM集計()
Application.ScreenUpdating = False
Dim db As ADODB.Connection
Dim rs As ADODB.Recordset
Dim mySQL As String
Dim cmd As ADODB.Command

Dim AA As Variant
AA = "AND 営業箇所" & Range("C13") & " AND 拒 IS NULL AND 販売伝票 <" & Range("D13") & " AND 品名 " & Range("E13") & " AND 得意先名 " & Range("F13") & " AND 請求先名 " & Range("G13") & " AND 出荷先名 " & Range("H13")

Set db = New ADODB.Connection
db.Provider = "Microsoft.Ace.OLEDB.12.0"
db.Open "\\▲▲▲\ACCESS.accdb"

With Worksheets("補助計算")

mySQL = " SELECT SUM(受注数量) FROM 今年 "
mySQL = mySQL & "WHERE 納入期日=" & Range("B13") & AA
Set rs = New ADODB.Recordset
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = db
cmd.CommandText = mySQL
Set rs = cmd.Execute
Range("I13").CopyFromRecordset rs

mySQL = " SELECT SUM(受注数量) FROM 今年 "
mySQL = mySQL & "WHERE 納入期日=" & Range("B14") & AA
Set rs = New ADODB.Recordset
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = db
cmd.CommandText = mySQL
Set rs = cmd.Execute
Range("I14").CopyFromRecordset rs

mySQL = " SELECT SUM(受注数量) FROM 前年 "
mySQL = mySQL & "WHERE 納入期日=" & Range("K14") & AA
Set rs = New ADODB.Recordset
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = db
cmd.CommandText = mySQL
Set rs = cmd.Execute
Range("M14").CopyFromRecordset rs

　　 mySQL = " SELECT SUM(受注数量) FROM 前年 "
mySQL = mySQL & "WHERE 納入期日=" & Range("K15") & AA
Set rs = New ADODB.Recordset
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = db
cmd.CommandText = mySQL
Set rs = cmd.Execute
Range("M15").CopyFromRecordset rs

rs.Close
Set rs = Nothing
Set db = Nothing
Application.ScreenUpdating = True
End With
End Sub
ーーーーーーーーーーーーーーーーーーーー
以上

回答No.3

NotFound404

今、対象とされているテーブルとテーブル構造が同じテーブルをコピペで作ります。
仮にテーブル名を抽出ベースとします。

Sub DSUM集計()
Application.ScreenUpdating = False
Dim db As ADODB.Connection
Dim rs As ADODB.Recordset
Dim mySQL As String
Dim cmd As ADODB.Command

Dim AA As Variant
AA = " 営業箇所" & Range("C13") & " AND 拒 IS NULL AND 販売伝票 <" & Range("D13") & " AND 品名 " & Range("E13") & " AND 得意先名 " & Range("F13") & " AND 請求先名 " & Range("G13") & " AND 出荷先名 " & Range("H13") & ";"

Set db = New ADODB.Connection

With db
　　.Provider = "Microsoft.ACE.OLEDB.12.0;"
　　.Properties("Data Source").Value = "\\▲▲▲\ACCESS.accdb"
　　.Open
End With

mySQL = "DELETE * FROM 抽出ベース"
CN.Execute mySQL '既存レコード削除

mySQL = "INSERT INTO 抽出ベース" & _
　　　　　　" SELECT * FROM 元テーブル名" & _
　　　　　　" WHERE " & AA
CN.Execute mySQL '抽出ベーステーブルへのレコード更新
’とすれば以下
With Worksheets("補助計算")

mySQL = " SELECT SUM(受注数量) FROM 抽出ベース "
mySQL = mySQL & "WHERE 納入期日=" & Range("B13") ' & AA

・・・省略

となるのでAAの抽出コストが無くなりますから
少しは速くなるのかな・・・と考えた次第です。
抽出ベーステーブルの更新に時間が掛かり効果が無いかもしれませんが、
サンプルを作るわけにもいかないので当方では検証不可です。

ただ実際には５倍の処理
シートへの書き込み＝４×５＝２０回くらい？
ごく大雑把に３０秒÷２０＝１．５秒なので対策しても微々たる効果しかないかもしれません。
ネットワーク経由など環境に依存する部分もあるので…。

お礼

ご回答ありがとうございます。遅くなりすみません。
ご教示いただきましたvbaをいちど試してみます。ありがとうございます。