CODEWITHSUNDEEP
sqlexcelvba
Max Bridge
Max Bridge

Reputation: 331

Run a excel macro with sql quicker?

This code do the work but takes 10 minutes to run. There is maybe a way in the sql part to make it faster. There is not a lot of data so I uspect the sql part. 

Dim noCsf As String
    Dim cel As Range
    Dim rng As Range
    Dim noRow As Integer
    Set rng = Sheets("CS_A").Range("D5:D68")
    Dim targetRng1 As Range

    Dim targetRng2 As Range

    Dim bd As String
    Dim cn As Object
    Dim rs1 As Object
    Dim rs2 As Object
    Dim strSql As String
    Dim strConnection As String
    Set cn = CreateObject("ADODB.Connection")
    Set rs1 = CreateObject("ADODB.Recordset")
    Set rs2 = CreateObject("ADODB.Recordset")

    bd = "U:\BD\Data_512_P.accdb"

    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & bd


    For Each cel In rng

        If Len(cel.Address) = 4 Then

            noRow = Right(cel.Address, 1)

        Else

            noRow = Right(cel.Address, 2)

        End If

        noCsf = cel.Value

        rs1.Open "SELECT SommeDetotal_euaii FROM Rqt_CS_Anglo WHERE Expr1 LIKE '" & noCsf & "'   ", cn, , , adCmdText

        Set targetRng1 = Sheets("CS_A").Range("E" & noRow)
        targetRng1.CopyFromRecordset rs1
        rs1.Close


        rs2.Open "SELECT SommeDeeua_apres_exemption FROM Rqt_CS_Anglo WHERE Expr1 LIKE '" & noCsf & "'  ", cn, , , adCmdText

        Set targetRng2 = Sheets("CS_A").Range("F" & noRow)
        targetRng2.CopyFromRecordset rs2
        rs2.Close

        noRow = noRow + 1

    Next

    Debug.Print "DONE"

    Set rs1 = Nothing
    Set rs2 = Nothing
    cn.Close
    Set cn = Nothing

I expect a quicker running time maybe the sql part could be improve the fact in take data from a access request

Upvotes: 1

Views: 76

Answers (1)

Tim Williams
Tim Williams

Reputation: 166511

Using a single query per line:

Const BD As String = "U:\BD\Data_512_P.accdb"
Dim cel As Range
Dim cn As Object
Dim rs As Object

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & BD

For Each cel In Sheets("CS_A").Range("D5:D68").Cells

    rs.Open "SELECT SommeDetotal_euaii, SommeDeeua_apres_exemption FROM " & _
             "Rqt_CS_Anglo WHERE Expr1 LIKE '" & cel.Value & "'   ", cn, , , adCmdText

    If Not rs.EOF Then
        With cel.EntireRow
            .Cells(5).Value = rs.Fields("SommeDetotal_euaii").Value
            .Cells(6).Value = rs.Fields("SommeDeeua_apres_exemption").Value
        End With
    End If

    rs.Close

Next cel

Depending on the size of the source table it may be quicker to build (eg) a lookup table using a scripting dictionary than to make repeated queries to the database.

If the database is on a mapped drive then creating a [temporary] local copy will likely speed things up.

If that still doesn't help then you can add more details about how many rows you're processing, are there any duplicates, and what's the size of your source DB table.

Upvotes: 1

Related Questions