Excel VBA功能与Recordset（性能问题） [英] Excel VBA function with Recordset (Performance issue)

问题描述

我在SQL Server中有一个数据库，用于在Excel中提供一些财务报表。我通过自定义Excel函数使用Recordsets，该函数使用Cells的参数来构建SQL查询。代码如下：

 公共函数测试（arg1 As String，arg2 As String，arg3 As Integer，arg4 As Integer ，arg5 As String）As Variant 
 Dim oConnection As ADODB.Connection 
 Set oConnection = New ADODB.Connection 
 Dim oRecordset As ADODB.Recordset 
 Set oRecordset = New ADODB.Recordset 
 
 Dim strSQL As String 
 
 strSQL =SELECT SUM（BALANCE）as Total FROM Accounting WHERE ARGUMENT1 =& Chr $（39）& arg1& Chr $（39）& AND ARGUMENT2 =& Chr $（39）& arg2& Chr $（39）& AND ARGUMENT3 =& Chr $（39）& arg3& Chr $（39）& AND ARGUMENT4 =& arg4& AND ARGUMENT5 =& arg5& 
 
 oConnection.OpenProvider = SQLOLEDB; &安培; _ 
数据源=（数据库的IP）; &安培; _ 
初始目录=（数据库目录）; &安培; _ 
Trusted_connection = yes; 
 
 oRecordset.Open来源：= strSQL，ActiveConnection：= oConnection，CursorType：= adOpenForwardOnly，LockType：= adLockReadOnly，Options：= adCmdText 
 
 
 Test = oRecordset总共
 
 oRecordset.Close 
设置oRecordset =无
 
 
结束函数
  

所以，这段代码工作得很好，但是我有一个性能问题。我必须填充数十个单元格，每个单元格使用来自不同单元格的不同参数。所以我有报告说需要1分钟以上才能加载。

我正在使用adOpenForwardOnly，但是还有其他很好的调整方式可以加快代码东西？

非常感谢你

解决方案

如果你的数据是不是特别时间敏感，那么你可以通过使用字典对象缓存先前查询的结果来记住你的UDF。

未测试：

$ b $公共函数测试（arg1 As String，arg2 As String，arg3 As Integer，_
arg4 As Integer，arg5 As String）As Variant

静态dict作为对象
Dim k As String，rv
Dim oConnection As ADODB.Connection
Dim oRecordset As ADODB.Recordset
Dim strSQL As String

'如果尚未创建，则创建字典
如果dict is Nothing然后
设置dict = CreateObject（scripting.dictionary）
如果

从参数
k = Join（Array（arg1，arg2，arg3，arg4，arg5），Chr（0））

'需要运行此查询创建一个唯一的密钥
如果不是dict.exists（k）然后

设置oConnection =新的ADODB.Connection
设置oRecordset =新的ADODB.Recordset

strSQL = SELECT SUM（BALANCE）as Total FROM Accounting WHERE ARGUMENT1 ='& _
arg1& 'AND ARGUMENT2 ='& arg2& _
'AND ARGUMENT3 ='& arg3& AND ARGUMENT4 =& arg4& _
AND ARGUMENT5 =& arg5&

oConnection.OpenProvider = SQLOLEDB; &安培; _
数据源=（数据库的IP）; &安培; _
初始目录=（数据库目录）; &安培; _
Trusted_connection = yes;

oRecordset.Open来源：= strSQL，ActiveConnection：= oConnection，_
CursorType：= adOpenForwardOnly，LockType：= adLockReadOnly，_
选项：= adCmdText


rv = oRecordset！总计

dict.Add k，rv

oRecordset.Close
设置oRecordset =没有

Else
'已经运行SQL - 只返回结果
rv = dict（k）
End If

Test = rv

结束功能

I have a database in SQL Server that I'm using to feed some financial reports in Excel. I'm using Recordsets through a custom Excel Function that uses arguments from Cells to build the SQL queries. Here is how the code looks:

 Public Function Test(arg1 As String, arg2 As String, arg3 As Integer, arg4 As Integer, arg5 As String) As Variant
    Dim oConnection As ADODB.Connection
    Set oConnection = New ADODB.Connection
    Dim oRecordset As ADODB.Recordset
    Set oRecordset = New ADODB.Recordset

    Dim strSQL As String

    strSQL = "SELECT SUM(BALANCE) as Total FROM Accounting WHERE ARGUMENT1 = " & Chr$(39) & arg1 & Chr$(39) & " AND ARGUMENT2 = " & Chr$(39) & arg2 & Chr$(39) & " AND ARGUMENT3 = " & Chr$(39) & arg3 & Chr$(39) & " AND ARGUMENT4 = " & arg4 & "  AND ARGUMENT5 = " & arg5 & ""

    oConnection.Open "Provider=SQLOLEDB;" & _
                         "Data Source=(IP of database);" & _
                         "Initial Catalog=(catalog of database);" & _
                         "Trusted_connection=yes;"

    oRecordset.Open Source:=strSQL, ActiveConnection:=oConnection, CursorType:=adOpenForwardOnly, LockType:=adLockReadOnly, Options:=adCmdText


    Test = oRecordset!Total

        oRecordset.Close
        Set oRecordset = Nothing


End Function

So, this code works very well but I'm having a performance issue. I have to fill dozens of cells, and each cell uses different arguments coming from different cells. So I have reports that take over 1 minute to load fully.

I'm using adOpenForwardOnly, but are there any other fine tunings I can do to the code to speed up things?

Thank you very much

解决方案

If your data is not particularly time-sensitive then you can "memoize" your UDF by having it cache previously-queried results using a dictionary object.

Untested:

Public Function Test(arg1 As String, arg2 As String, arg3 As Integer, _
                            arg4 As Integer, arg5 As String) As Variant

    Static dict As Object
    Dim k As String, rv
    Dim oConnection As ADODB.Connection
    Dim oRecordset As ADODB.Recordset
    Dim strSQL As String

    'create the dictionary if not already created
    If dict Is Nothing Then
        Set dict = CreateObject("scripting.dictionary")
    End If

    'create a unique "key" from the arguments
    k = Join(Array(arg1, arg2, arg3, arg4, arg5), Chr(0))

    'need to run this query?
    If Not dict.exists(k) Then

        Set oConnection = New ADODB.Connection
        Set oRecordset = New ADODB.Recordset

        strSQL = "SELECT SUM(BALANCE) as Total FROM Accounting WHERE ARGUMENT1 = '" & _
                 arg1 & "' AND ARGUMENT2 = '" & arg2 & _
                 "' AND ARGUMENT3 = '" & arg3 & "' AND ARGUMENT4 = " & arg4 & _
                 "  AND ARGUMENT5 = " & arg5 & ""

        oConnection.Open "Provider=SQLOLEDB;" & _
                             "Data Source=(IP of database);" & _
                             "Initial Catalog=(catalog of database);" & _
                             "Trusted_connection=yes;"

        oRecordset.Open Source:=strSQL, ActiveConnection:=oConnection, _
                        CursorType:=adOpenForwardOnly, LockType:=adLockReadOnly, _
                        Options:=adCmdText


        rv = oRecordset!Total

        dict.Add k, rv

        oRecordset.Close
        Set oRecordset = Nothing

    Else
        'already ran the SQL - just return the result
        rv = dict(k)
    End If

    Test = rv

End Function

这篇关于Excel VBA功能与Recordset（性能问题）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！