此代码可以完成工作,但需要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部分可以改善从访问请求中获取数据的事实
答案 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
根据源表的大小,使用脚本字典来建立(例如)查找表要比对数据库进行重复查询更快。
如果数据库位于映射的驱动器上,则创建[临时]本地副本可能会加快处理速度。
如果仍然不能解决问题,则可以添加更多详细信息,包括正在处理的行数,重复项以及源数据库表的大小。