ExcelVBA抓Access資料速度優化請益

a5345534

Access，8,500筆資料
EXCEL，116,000筆資料

原諒我沒有權限上傳與分享網址....

邏輯是先到EXCEL抓取料號資料後，到Access資料庫抓取同料號的數量資訊，代入Excel

目標是透過Access資料庫搭配Excel VBA的模式讓臃腫的Excel函數能夠快一點，否則原本的資料太大，公司電腦無法負荷
但寫完程式後，卻發現抓的比我Excel用Vlookup還慢，只比對前1500筆就要15秒

是否我VBA哪裡寫的效率太低呢，麻煩高手助我指點迷津!!

1. Sub CreateQueryRS()
   
2. Application.Calculation = xlCalculationManual
   
3. Application.ScreenUpdating = False
   
4. Application.DisplayStatusBar = False
   
5. Application.EnableEvents = False
   
6.     Dim cnADO As Object
   
7.     Dim rsADO As Object
   
8.     Dim strPath As String
   
9.     Dim strSQL As String
   
10.     Dim j As String
    
11.     Dim i As Long
    
12.     Set cnADO = CreateObject("ADODB.Connection")
    
13.     Set rsADO = CreateObject("ADODB.RecordSet")
    
14.     strPath = ThisWorkbook.Path & "\Database11.accdb"
    
15.     Range("表格1[上期期末金額]").ClearContents
    
16. 
    
17.     'ThisWorkbook.Sheets("11009進銷存明細表").Cells(2, 3).Value = ThisWorkbook.Sheets("11009進銷存明細表").Range("表格1[料品編號]").Rows.Count
    
18. 
    
19. 
    
20.     On Error GoTo ErrMsg
    
21.    
    
22.     cnADO.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath
    
23. 
    
24.     For i = 0 To 1500
    
25. '    For i = 0 To ThisWorkbook.Sheets("11009進銷存明細表").Range("表格1[料品編號]").Rows.Count - 1
    
26.    
    
27.         j = ActiveSheet.Cells(4 + i, 3).Value
    
28.         strSQL = "SELECT SUM(交易數量) FROM B1進貨資料 WHERE 料品編號= '" & j & "' AND 類別='進貨'"
    
29.         rsADO.Open strSQL, cnADO, 1, 3
    
30.         'Range("A410").CopyFromRecordset rsADO
    
31.         ActiveSheet.Cells(4 + i, 1).CopyFromRecordset rsADO
    
32.         rsADO.Close
    
33. 
    
34.     Next i
    
35. 
    
36.     cnADO.Close
    
37.     Set rsADO = Nothing
    
38.     Set cnADO = Nothing
    
39. Application.Calculation = xlCalculationAutomatic
    
40. Application.ScreenUpdating = True
    
41. Application.DisplayStatusBar = True
    
42. Application.EnableEvents = True
    
43.     Exit Sub
    
44. ErrMsg:
    
45.     MsgBox Err.Description, , "錯誤報告"
    
46. End Sub

複製代碼

samwang

回復 1# a5345534

原諒我沒有權限上傳>> 上傳應該都可以上傳檔案
要改善速度，建議用陣列+字典