将Pivot Cache从一个文件上的Pivot传输到另一个文件上的Pivot？

Question

我需要安全地将Excel文件上的数据透视表的缓存转移到另一个文件的数据透视表中。我怎么能这样做？

这是我现在使用的代码 （请注意，即使已消除了源数据透视表数据源，此方法仍然有效）：

Public Sub TransferPivotCache(Source As PivotTable, Target As PivotTable)
    Dim TempSheet As Worksheet
    Set TempSheet = ThisWorkbook.Sheets.Add
    Source.TableRange2.Copy Destination:=TempSheet.Range("A1")
    Target.CacheIndex = TempSheet.PivotTables(1).CacheIndex
    TempSheet.Delete
End Sub

然而，当我导入的数据透镜太大时，我在修改缓存索引属性时收到错误“内存不足”。然后，即使文件关闭，如果我尝试重新打开它，它就会被破坏。有没有更好的方法在数据透视表之间传输数据透视表缓存？

Answer 1

如果您的目标是更新另一个定位相同数据的数据透视表，那么另一种方法是创建指向同一源的新PivotCache。这样，目标工作簿将构建相同的PivotCache，而无需复制DataTable，这可能是导致内存问题的原因。

Public Sub TransferPivotCache(source As PivotTable, target As PivotTable)
    Dim pivCache As PivotCache, sh As Worksheet, rgData As Range, refData

    ' convert the `SourceData` from `xlR1C1` to `xlA1` '
    source.Parent.Activate
    refData = Application.ConvertFormula(source.SourceData, xlR1C1, xlA1, xlAbsolute)
    If IsError(refData) Then refData = source.SourceData

    If Not IsError(source.Parent.Evaluate(refData)) Then
        ' create a new pivot cache from the data source if it exists '

        Set rgData = source.Parent.Evaluate(refData)
        If Not rgData.ListObject Is Nothing Then Set rgData = rgData.ListObject.Range

        Set pivCache = target.Parent.Parent.PivotCaches.Create( _
          XlPivotTableSourceType.xlDatabase, _
          rgData.Address(external:=True))

        pivCache.EnableRefresh = False
        target.ChangePivotCache pivCache
    Else
        ' copy the pivot cache since the data source no longer exists '

        Set sh = source.Parent.Parent.Sheets.Add
        source.PivotCache.CreatePivotTable sh.Cells(1, 1)
        sh.Move after:=target.Parent  ' moves the temp sheet to targeted workbook '

        ' replace the pivot cache '
        target.PivotCache.EnableRefresh = True
        target.CacheIndex = target.Parent.Next.PivotTables(1).CacheIndex
        target.PivotCache.EnableRefresh = False

        'remove the temp sheet '
        target.Parent.Next.Delete
    End If

End Sub

Answer 2

我无法使用 Excel Professional 2010 重现资源问题...但您尝试过这种简单的可能性吗？：

{{1}}

看起来它是一样的（至少在同一个工作簿中），它避免了创建一个全新的工作表。