以下のエクセル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
ーーーーーーーーーーーーーーーーーーーー
以上
Excel２０１３でVBAを動かすと「型が一致しません」と表示され、
動作が中断されます。
解決方法がわからないので、教えてください。
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Dim i As Long, k As Long, MaxRow As Long
MaxRow = Range("H" & Rows. Count).End(xlUp).Row
k = 2
For i = 2 To MaxRow
If Month(Range("H" & i)) <> Month(Range("H" & i + 1)) Then ← ここで中断する
Range(Cells(i, 8), Cells(i, 10)).Copy
Cells(k, 1).PasteSpecial Paste:=xlPasteValues
Else
Range(Cells(i, 8), Cells(i, 10)).Copy
Cells(k, 1).PasteSpecial Paste:=xlPasteValues
k + 1
End if
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
「on Error Resume Next 」をエラー箇所の前に追加すると
最後まで動き、正しい結果になります。
しかし、こんな解決方法でいいのか不安なので、
別の解決方法がわかれば、教えてください。
よろしくお願いします。
Hello friends of OKWave,
my name is Jose.
first sorry I am no able to write Japanese language. I write you from Spain, Malaga.
Please help me if possible with the following question:
There is some way to activate Printing TEST mode (just see how is printing the head) in EPSON VP-2016? with the console buttons (maybe service mode combination at startup)? or with PIN combinations?
Probably this information is into Service Manual or User Manual, but I have no manual of this printer. If available, even in English or Japanese language, please send to my email.
Thank you very much.
Domo arigato. (Muchas gracias)
