MS Excel 2003:部分刷新数据透视缓存或合并数据透视缓存

MS Excel 2003:部分刷新数据透视缓存或合并数据透视缓存,excel,ms-access,vba,Excel,Ms Access,Vba,我有一个连接到Access数据库查询的Excel数据透视缓存。但是,如果我在Access中更改源数据(例如更改值、添加/删除记录),我必须刷新数据透视缓存,数据透视缓存将再次运行查询以检索整个数据集上的所有记录。这是非常低效的。我只想检索经常更改的记录(理想情况下,只检索更改的记录,但这将是未来的考虑事项) 我尝试了以下解决方案,但它们不适合我的目的: *在同一工作表中的Excel中创建两个查询表,并在包含这两个查询表的整个工作表上创建透视表。我只刷新“当前”查询表。但是,我被限制为65536行

我有一个连接到Access数据库查询的Excel数据透视缓存。但是,如果我在Access中更改源数据(例如更改值、添加/删除记录),我必须刷新数据透视缓存,数据透视缓存将再次运行查询以检索整个数据集上的所有记录。这是非常低效的。我只想检索经常更改的记录(理想情况下,只检索更改的记录,但这将是未来的考虑事项)

我尝试了以下解决方案,但它们不适合我的目的:
*在同一工作表中的Excel中创建两个查询表,并在包含这两个查询表的整个工作表上创建透视表。我只刷新“当前”查询表。但是,我被限制为65536行,这比我的查询中的记录数少。
*创建两个透视表。但是,用户必须设置两次透视表,这太费劲了。我希望优化发生在幕后,而不是用户必须改变他们的习惯

我现在考虑的潜在解决方案是使用两个ADO记录集刷新数据透视缓存,一个用于历史数据,另一个用于频繁更改的当前数据。如果更改当前数据,则仅对当前数据集运行查询

但是,我似乎在将数据透视缓存转换为ADO记录集时遇到问题。行“pvtRecordset.MoveFirst”抛出一个错误。它用于测试目的。如果该行不起作用,则无法使用rsCombineRecordsets函数将新记录集与数据透视缓存组合

另一种方法是将ADO记录集转换为数据透视缓存(即set pivotcache.recordset=ADOrecordset)。历史数据上的ADO记录集保存在内存中,因此我们只需打开记录集一次。然而,我也不知道如何让它发挥作用。透视表数据保持不变,因为它仍然显示“strSqlHist”的结果,而不是“strSqlHist”和“strSqlCurr”的组合

Sub-Main()
刷新数据透视缓存“当前”
端接头
公共函数RefreshPivotCache(strRefreshCmd作为字符串)
将cnn设置为新的ADODB.连接
将rst设置为新ADODB.Recordset
将pvtCache设置为数据透视缓存
将pvtRecordset设置为ADODB.Recordset
作为数据透视表的Dim ptt
Dim strSqlHist作为字符串,strSqlCurr作为字符串
作为字符串的Dim strCon
将RST集合变暗为新集合
strCon=“Provider=Microsoft.Jet.OLEDB.4.0;”_
“数据源=I:\Cash Management\Cash\M.mdb;”
strSqlHist=“选择*自v_CFMT,其中Trx_日期<日期值('01-DEC-2009')”
strSqlCurr=“从v\u CFMT中选择*其中Trx\u Date>=DateValue('01-DEC-2009')”
如果strRefreshCmd=“新建”,则
'打开连接并填充记录集。
cnn,打开strCon
设置rst=cnn.Execute(strSqlHist)
'添加透视缓存并将缓存源分配给记录集
设置pvtCache=ThisWorkbook.PivotCaches.Add(SourceType:=xlExternal)
设置pvtCache.Recordset=rst
'创建数据透视表并分配给数据透视缓存
设置ptt=pvtCache.CreatePivotTable(TableDestination:=ActiveCell,TableName:=“PT_ADO”)
ElseIf strRefreshCmd=“当前”然后
'打开连接并填充记录集。
cnn,打开strCon
设置rst=cnn.Execute(strSqlCurr)
'将数据透视缓存转换为记录集-不起作用
Set pvtRecordset=ActiveCell.PivotTable.PivotCache.Recordset
关闭对象时,不允许执行“pvtRecordset.MoveFirst”操作
'合并两个记录集并分配给数据透视缓存记录集
RST收集。添加PVT记录集
rst收集。添加rst
Set pvtRecordset=rscombinerecordset(rstCollection)'自定义函数。
如果结束
'从内存中释放对象
有线电视新闻网,结束
设置cnn=无
如果CBool(rst.State和adStateOpen),则rst.Close
设置rst=无
设置ptt=无
设置rstCollection=Nothing
端函数

总之,如何部分刷新数据透视缓存或合并两个数据透视缓存?

当您说“将记录集存储到内存中”时,您是否试图获取断开连接的记录集?看

Sub Main()
    RefreshPivotCache "CURRENT"
End Sub

Public Function RefreshPivotCache(strRefreshCmd As String)
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim pvtCache As PivotCache
    Dim pvtRecordset As ADODB.Recordset
    Dim ptt As PivotTable
    Dim strSqlHist As String, strSqlCurr As String
    Dim strCon As String
    Dim rstCollection As New Collection

    strCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=I:\Cash Management\Cash_M.mdb;"

    strSqlHist = "SELECT * FROM v_CFMT WHERE Trx_Date < DateValue('01-DEC-2009')"
    strSqlCurr = "SELECT * FROM v_CFMT WHERE Trx_Date >= DateValue('01-DEC-2009')"

    If strRefreshCmd = "NEW" Then

        'Open the connection and fill the Recordset.
        cnn.Open strCon
        Set rst = cnn.Execute(strSqlHist)

        'Add pivot cache and assign the cache source to the recordset
        Set pvtCache = ThisWorkbook.PivotCaches.Add(SourceType:=xlExternal)
        Set pvtCache.Recordset = rst

        'Create pivot table and assign to pivot cache
        Set ptt = pvtCache.CreatePivotTable(TableDestination:=ActiveCell, TableName:="PT_ADO")

    ElseIf strRefreshCmd = "CURRENT" Then
        'Open the connection and fill the Recordset.
        cnn.Open strCon
        Set rst = cnn.Execute(strSqlCurr)

        'Convert pivotcache to recordset - does not work
        Set pvtRecordset = ActiveCell.PivotTable.PivotCache.Recordset
        pvtRecordset.MoveFirst 'Operation is not allowed when the object is closed

        'Combine the two recordsets and assign to the pivotcache recordset
        rstCollection.Add pvtRecordset
        rstCollection.Add rst
        Set pvtRecordset = rsCombineRecordsets(rstCollection) 'custom function.

    End If

    'Release objects from memory
    cnn.Close
    Set cnn = Nothing
    If CBool(rst.State And adStateOpen) Then rst.Close
    Set rst = Nothing
    Set ptt = Nothing
    Set rstCollection = Nothing
End Function