使用宏刷新我的 excel 工作簿中的所有数据透视表

Posted 2023-02-22

技术标签:

【中文标题】使用宏刷新我的 excel 工作簿中的所有数据透视表【英文标题】：Refreshing all the pivot tables in my excel workbook with a macro 【发布时间】：2010-09-09 09:57:18 【问题描述】：

我有一个包含 20 个不同数据透视表的工作簿。有没有什么简单的方法可以在 VBA 中找到所有数据透视表并刷新它们？

【问题讨论】：

【参考方案1】：

是的。

ThisWorkbook.RefreshAll

或者，如果您的 Excel 版本足够旧，

Dim Sheet as WorkSheet, Pivot as PivotTable
For Each Sheet in ThisWorkbook.WorkSheets
    For Each Pivot in Sheet.PivotTables
        Pivot.RefreshTable
        Pivot.Update
    Next
Next

【讨论】：

哦，投反对票。五年多之后，这是一个令人耳目一新的变化；）确实..这令人耳目一新..有人甚至试图关闭这个问题作为题外话...这不像我要求只使用鼠标或任何东西来做：D 太棒了，我不得不使用它，因为我想在获得新的外部数据后刷新枢轴，所以 ThisWorkbook.RefreshAll 不适合我。只是一个注释。 ThisWorkbook.RefreshAll 方法由于某种原因不起作用，如果 Application.Calculation = xlCalculationManual。使用代码前将计算属性设置为Application.Calculation = xlCalculationAutomatic。 @GSerg 抱歉恢复这个旧帖子，但我有一个问题（发布Here）：我们需要在RefreshTable 之后做一个Update 吗？两者有什么区别？【参考方案2】：

此 VBA 代码将刷新工作簿中的所有数据透视表/图表。

Sub RefreshAllPivotTables()

Dim PT As PivotTable
Dim WS As Worksheet

    For Each WS In ThisWorkbook.Worksheets

        For Each PT In WS.PivotTables
          PT.RefreshTable
        Next PT

    Next WS

End Sub

另一个非编程选项是：

右键单击每个数据透视表选择表格选项勾选“打开时刷新”选项。点击确定按钮

这将在每次打开工作簿时刷新数据透视表。

【讨论】：

【参考方案3】：

ActiveWorkbook.RefreshAll 刷新所有内容，不仅是数据透视表，还包括 ODBC 查询。我有几个引用数据连接的 VBA 查询，使用此选项会崩溃，因为命令运行数据连接时没有 VBA 提供的详细信息

如果您只想刷新枢轴，我推荐该选项

Sub RefreshPivotTables()     
  Dim pivotTable As PivotTable     
  For Each pivotTable In ActiveSheet.PivotTables         
    pivotTable.RefreshTable     
  Next 
End Sub

【讨论】：

查看投票最多的答案.. 第二种方法实际上是您在这里尝试的方法.. 但对于整个繁荣.. 不仅适用于活动表.. 任何一种情况都取决于.. 我从那以后就没有碰过它.. 如果数据透视表不在活动工作表中怎么办？【参考方案4】：

在某些情况下，您可能希望区分数据透视表和它的数据透视缓存。 Cache 有自己的刷新方法和自己的集合。所以我们可以刷新所有数据透视缓存而不是数据透视表。

区别？当您创建一个新的数据透视表时，系统会询问您是否希望它基于以前的表。如果您拒绝，则此数据透视表将获得自己的缓存并将源数据的大小翻倍。如果您同意，您的 WorkBook 将保持较小，但您会添加到共享单个缓存的数据透视表集合中。当您刷新该集合中的任何单个数据透视表时，整个集合都会刷新。因此，您可以想象刷新 WorkBook 中的每个缓存与刷新 WorkBook 中的每个数据透视表之间的区别。

【讨论】：

【参考方案5】：

数据透视表工具栏中有一个全部刷新选项。足够了。不必做任何其他事情。

按 ctrl+alt+F5

【讨论】：

我不同意。如果 Lipis 想要自动化刷新过程，例如，每当单元格发生更改时怎么办？【参考方案6】：

您在 VB Worksheet 对象上有一个 PivotTables 集合。因此，像这样的快速循环将起作用：

Sub RefreshPivotTables()
    Dim pivotTable As PivotTable
    For Each pivotTable In ActiveSheet.PivotTables
        pivotTable.RefreshTable
    Next
End Sub

战壕笔记：

经常保存

祝你好运！

【讨论】：

【参考方案7】：

代码

Private Sub Worksheet_Activate()
    Dim PvtTbl As PivotTable
        Cells.EntireColumn.AutoFit
        For Each PvtTbl In Worksheets("Sales Details").PivotTables
        PvtTbl.RefreshTable
        Next
End Sub

工作正常。

该代码用于激活工作表模块，因此在激活工作表时会显示闪烁/故障。

【讨论】：

【参考方案8】：

甚至我们也可以刷新特定的连接，然后它会刷新所有链接到它的枢轴。

对于这段代码，我从 Excel 中的表格创建了切片器：

Sub UpdateConnection()
        Dim ServerName As String
        Dim ServerNameRaw As String
        Dim CubeName As String
        Dim CubeNameRaw As String
        Dim ConnectionString As String

        ServerNameRaw = ActiveWorkbook.SlicerCaches("Slicer_ServerName").VisibleSlicerItemsList(1)
        ServerName = Replace(Split(ServerNameRaw, "[")(3), "]", "")

        CubeNameRaw = ActiveWorkbook.SlicerCaches("Slicer_CubeName").VisibleSlicerItemsList(1)
        CubeName = Replace(Split(CubeNameRaw, "[")(3), "]", "")

        If CubeName = "All" Or ServerName = "All" Then
            MsgBox "Please Select One Cube and Server Name", vbOKOnly, "Slicer Info"
        Else
            ConnectionString = GetConnectionString(ServerName, CubeName)
            UpdateAllQueryTableConnections ConnectionString, CubeName
        End If
    End Sub

    Function GetConnectionString(ServerName As String, CubeName As String)
        Dim result As String
        result = "OLEDB;Provider=MSOLAP.5;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=" & CubeName & ";Data Source=" & ServerName & ";MDX Compatibility=1;Safety Options=2;MDX Missing Member Mode=Error;Update Isolation Level=2"
        '"OLEDB;Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=" & CubeName & ";Data Source=" & ServerName & ";Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Use Encryption for Data=False;Tag with column collation when possible=False"
        GetConnectionString = result
    End Function

    Function GetConnectionString(ServerName As String, CubeName As String)
    Dim result As String
    result = "OLEDB;Provider=MSOLAP.5;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=" & CubeName & ";Data Source=" & ServerName & ";MDX Compatibility=1;Safety Options=2;MDX Missing Member Mode=Error;Update Isolation Level=2"
    GetConnectionString = result
End Function

Sub UpdateAllQueryTableConnections(ConnectionString As String, CubeName As String)
    Dim cn As WorkbookConnection
    Dim oledbCn As OLEDBConnection
    Dim Count As Integer, i As Integer
    Dim DBName As String
    DBName = "Initial Catalog=" + CubeName

    Count = 0
    For Each cn In ThisWorkbook.Connections
        If cn.Name = "ThisWorkbookDataModel" Then
            Exit For
        End If

        oTmp = Split(cn.OLEDBConnection.Connection, ";")
        For i = 0 To UBound(oTmp) - 1
            If InStr(1, oTmp(i), DBName, vbTextCompare) = 1 Then
                Set oledbCn = cn.OLEDBConnection
                oledbCn.SavePassword = True
                oledbCn.Connection = ConnectionString
                oledbCn.Refresh
                Count = Count + 1
            End If
        Next
    Next

    If Count = 0 Then
         MsgBox "Nothing to update", vbOKOnly, "Update Connection"
    ElseIf Count > 0 Then
        MsgBox "Update & Refresh Connection Successfully", vbOKOnly, "Update Connection"
    End If
End Sub

【讨论】：

【参考方案9】：

我最近使用过下面列出的命令，它似乎工作正常。