Выполните запрос один раз для всего столбца вместо циклического прохождения всех ячеек. - PullRequest
Новая
       15

Выполните запрос один раз для всего столбца вместо циклического прохождения всех ячеек.

0 голосов
/ 19 июня 2019

Я использую цикл ниже, чтобы пройти через столбец и выполнить запрос для каждого значения ячейки. Учитывая, что количество ячеек в этом столбце может легко превышать 10 000 строк, это не очень быстрый метод, и поэтому я ищу другой метод повышения производительности.

Я думаю о заполнении массива значениями ячеек, но с помощью этого метода, скорее всего, все еще будет необходимо выполнить итерацию по указанному массиву и выполнить запрос для каждой итерации.

Я не знаком ни с одним методом, который мог бы выполнить запрос один раз или, по крайней мере, значительно повысить производительность для этой процедуры. Есть идеи? 

Public Function getdata(query As String) As ADODB.Recordset
Dim cnn As ADODB.Connection
Dim connstring As String
Set cnn = New ADODB.Connection

connstring = "Provider=SQLOLEDB;Data Source=noneofyourbusiness;Connect Timeout=180"
cnn.Open connstring

Set getdata = New ADODB.Recordset
    getdata.CursorLocation = adUseClient
getdata.Open query, connstring, 2, adLockReadOnly
End Function

Sub start()
'code...

For Each c In sht.Range("J3:J" & LRow)
    If Not c.Value = "" Then
        'Query
        Set rs = getdata("SELECT 'Checked' FROM astAssetTypes AT JOIN astAssetTypesUDFV UDFV ON UDFV.TableLinkId = AT.Id WHERE UDFV.Userfield13Id = '5029' AND AT.Code = '" & c.Value & "'")
        If Not rs.EOF Then
            sht.Cells(c.Row, "L").CopyFromRecordset rs
            With sht.Range(sht.Cells(c.Row, "A"), sht.Cells(c.Row, LCol)).Font
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -0.349986266670736
            End With
            rs.Close
        End If
    End If
Next c

'code...
End Sub

Ответы [ 2 ]

1 голос
/ 19 июня 2019 
Sub start()

    Dim strCodes$, rng1 As Range, rng2 As Range, cell As Range

    '// Generate "IN" clause
    For Each c In sht.Range("J3:J" & LRow)
        If Len(c) > 0 Then
            strCodes = strCodes & "'" & c & "'" & IIf(c.Row = LRow, "", ",")
        End If
    Next

    'Query
    Set rs = getdata( _
        "SELECT 'Checked', AT.Code FROM astAssetTypes AT JOIN astAssetTypesUDFV UDFV ON UDFV.TableLinkId = AT.Id " & _
        "WHERE UDFV.Userfield13Id = '5029' AND AT.Code IN (" & strCodes & ");")
    While Not rs.EOF
        Set cell = sht.Columns("J:J").Find(rs("Code"), LookAt:=xlWhole)
        If Not cell Is Nothing Then
            If rng1 Is Nothing Then
                Set rng1 = sht.Cells(cell.Row, "L")
            Else
                Set rng1 = Union(rng1, sht.Cells(cell.Row, "L"))
            End If
            If rng2 Is Nothing Then
                Set rng2 = sht.Cells(cell.Row, "A").Resize(, LCol)
            Else
                Set rng2 = Union(rng2, sht.Cells(cell.Row, "A").Resize(, LCol))
            End If
        End If
        rs.MoveNext
    Wend

    '// Dump result
    rng1.Value = "Checked"
    With rng2.Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.349986266670736
        End With
    End With

End Sub
1 голос
/ 19 июня 2019

Метод 1.

Если у вас есть dbo на SQL, тогда создайте временную таблицу и загрузите туда данные Excel.Сделайте это за один проход, используя эффективный метод построения строк (т. Е. Используйте Mid вместо замены, а не для конкатенации констант).Или используйте Integration для прямой загрузки данных.Запустите запрос и отбросьте данные обратно.Определите, какие ячейки необходимо отформатировать, и выполните их сразу (выполните цикл с Union, чтобы получить один большой диапазон).

Метод 2.

Используйте курсор на стороне клиента, загрузите все свои данныеиз SQL и используйте rs.Filter, чтобы найти соответствующую запись.Вы можете загрузить свои данные Excel в массив или отключенный набор записей и вернуть их обратно.

Важным моментом является отсутствие ненужной обратной записи в Excel.В Excel должно быть не более двух записей.

Что-то вроде (код не полностью протестирован) 

Dim rsLocal As ADODB.Recordset ' create a local, disconnected recordset
Set rsLocal = New ADODB.Recordset
rsLocal.CursorLocation = adUseClient
rsLocal.Fields.Append "L", adVarChar, 1024, adFldIsNullable ' change to suit your data
rsLocal.Open

Dim myRange As Range

rs.CursorLocation = adUseClient
'bring all the records back into memory
Set rs = GetData("SELECT 'Checked', AT.Code Code FROM astAssetTypes AT JOIN astAssetTypesUDFV UDFV ON UDFV.TableLinkId = AT.Id WHERE UDFV.Userfield13Id = '5029' AND AT.Code = '")


For Each c In sht.Range("J3:J" & lrow)
    rsLocal.AddNew
    If c.Value <> "" Then
        rs.Filter = "Code='" & c.Value & "'" 'use Filter to prevent lots of round trips
        If rs.RecordCount <> 0 Then
            rs.MoveFirst
            rsLocal("L") = rs("Code")

            'add the cells to the range as we go
            If myRange Is Nothing Then
                Set myRange = sht.Range(sht.cells(c.Row, "A"), sht.cells(c.Row, LCol))
            Else
                Set myRange = Union(sht.Range(sht.cells(c.Row, "A"), sht.cells(c.Row, LCol)), myRange)
            End If
        End If
    End If
    rsLocal.Update
Next

rsLocal.MoveFirst
sht.Range("L3").CopyFromRecordset rsLocal 'write all updates at once

With myRange.Font ' do all formatting at once
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.349986266670736
End With
...