使用SQL更快地运行Excel宏?

时间:2019-07-11 15:50:11

标签: sql excel vba

此代码可以完成工作,但需要10分钟才能运行。 sql部分中可能有一种使它更快的方法。没有很多数据,所以我希望使用sql部分。

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

我希望运行时间更快,也许sql部分可以改善从访问请求中获取数据的事实

1 个答案:

答案 0 :(得分:1)

每行使用一个查询:

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

根据源表的大小,使用脚本字典来建立(例如)查找表要比对数据库进行重复查询更快。

如果数据库位于映射的驱动器上,则创建[临时]本地副本可能会加快处理速度。

如果仍然不能解决问题,则可以添加更多详细信息,包括正在处理的行数,重复项以及源数据库表的大小。