0
У меня есть код ниже, и, кажется, требуется некоторое время, чтобы открыть набор записей и запустить запрос, прикрепленный (точнее, через 62 секунды). Хотя 1 минута в порядке, когда мне нужно сделать это 13 раз, для запуска кода требуется много времени.Ускорение запроса sqs sqs от excel
Я отлаживал код вплоть до открытия набора записей, занимающего самое длинное время.
Мой вопрос: есть ли способ выполнить это быстрее? (Я имею подключение к MS Access 2013 из Excel 2013)
Спасибо заранее,
Rich
Sub GetUnits2()
'Declaring the necessary variables.
Dim con As Object
Dim rs As Object
Dim AccessFile As String
Dim strTable As String
Dim SQL As String
Dim myValues() As Variant
Dim i As Long
Dim k As Long
Dim j As Integer
Dim SheetName As String
Dim WeekNumber As Long
Dim year As Long
Dim Model1 As String
Dim Model2 As String
Dim xlrow As Integer
Dim xlcol As Integer
SheetName = "Sheet2"
Sheets(SheetName).Select
Model1 = Sheets(SheetName).Cells(3, 2).Value
Model2 = Sheets(SheetName).Cells(4, 2).Value
'Disable screen flickering.
Application.ScreenUpdating = False
'Specify the file path of the accdb file. You can also use the full path of the file like:
AccessFile = "C:\Users\rich.wolff\Desktop\2014POSDatabase\HMKPOSDatabase2014.accdb"
On Error Resume Next
'Create the ADODB connection object.
Set con = CreateObject("ADODB.connection")
'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Connection was not created!", vbCritical, "Connection error"
Exit Sub
End If
On Error GoTo 0
'Open the connection.
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFile
'Set Current Week, Year, & Starting Cell
WeekNumber = Sheets(SheetName).Cells(8, 14).Value
year = Sheets(SheetName).Cells(9, 14).Value
xlcol = 14 'Starting Column
xlrow = 11 'Starting Row
'Open Query Loop
For k = 1 To 1
SQL = "SELECT Sum(StoreSalesData.QTY) AS Units"
SQL = SQL & " FROM VSNConversionData INNER JOIN ([Sleepys Store List] INNER JOIN StoreSalesData ON [Sleepys Store List].[Store Code] = StoreSalesData.STR) ON VSNConversionData.VSN = StoreSalesData.VSN"
SQL = SQL & " WHERE (((VSNConversionData.VSNStyle)='" & Model2 & "') AND ((StoreSalesData.WeekNum)=" & WeekNumber & ") AND ((StoreSalesData.Year)=" & year & ") AND ((StoreSalesData.STR) In (SELECT FloorModels2.[Source Org]"
SQL = SQL & " FROM FloorModels2"
SQL = SQL & " WHERE (((FloorModels2.[Source Org]) In (SELECT FloorModels2.[Source Org]"
SQL = SQL & " FROM FloorModels2"
SQL = SQL & " WHERE (((FloorModels2.WeekNumber)=" & WeekNumber & ") AND ((FloorModels2.Year)=" & year & ") AND ((FloorModels2.VSNStyle)='" & Model1 & "')))) AND ((FloorModels2.WeekNumber)=" & WeekNumber & ") AND ((FloorModels2.Year)=" & year & ") AND ((FloorModels2.VSNStyle)='" & Model2 & "')))));"
On Error Resume Next
'Create the ADODB recordset object.
Set rs = CreateObject("ADODB.recordset")
'Check if the object was created.
If Err.Number <> 0 Then
Set rs = Nothing
Set con = Nothing
MsgBox "Connection was not created!", vbCritical, "Connection error"
Exit Sub
End If
On Error GoTo 0
'Set thee cursor location.
rs.CursorLocation = 3 'adUseClient on early binding
rs.CursorType = 1 'adOpenKeyset on early binding
'Open the recordset.
rs.Open SQL, con
'Redim the table that will contain the filtered data.
ReDim myValues(rs.RecordCount)
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Dim dbcol As Integer
dbcol = 0
Worksheets(SheetName).Cells(xlrow, xlcol).ClearContents
Worksheets(SheetName).Cells(xlrow, xlcol).Value = rs(dbcol).Value
Else
rs.Close
con.Close
Set rs = Nothing
Set con = Nothing
Application.ScreenUpdating = True
MsgBox "There are no records in the recordset!", vbCritical, "No Records"
Exit Sub
End If
'Close the recordet
rs.Close
Set rs = Nothing
If WeekNumber = 1 Then
year = year - 1
WeekNumber = 52
Else
year = year
WeekNumber = WeekNumber - 1
End If
' Next Column
xlcol = xlcol - 1
Next
'End Query Loop
con.Close
Set rs = Nothing
Set con = Nothing
Application.ScreenUpdating = True
End Sub
Что происходит, когда вы запускаете запрос из Access? Я думаю, что это упростит нам задачу * и * отлаживать и оптимизировать такой запрос из самого Access и удалять весь «шум» Excel. Структура таблицы, индексы и другая информация о вашей базе данных, вероятно, более актуальны, чем этот код VBA. – GolezTrol
Занимает около 9 секунд, чтобы выполнить запрос в доступе. – RichWolff
Я согласен с @GolezTrol - трудно себе представить, почему Excel служит центром этого приложения. Ответ за 9 секунд только усиливает это восприятие. – Smandoli