代码之家  ›  专栏  ›  技术社区  ›  Lipis

用宏刷新Excel工作簿中的所有透视表

  •  76
  • Lipis  · 技术社区  · 16 年前

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

    10 回复  |  直到 6 年前
        1
  •  155
  •   airstrike SilentGhost    11 年前

    对。

    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
    
        2
  •  23
  •   Robert Mearns    16 年前

    此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
    

    另一个非编程选项是:

    • 右键单击每个透视表
    • 选择表选项
    • 蜱类 '打开时刷新' 选择权。
    • 点击OK按钮

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

        3
  •  18
  •   jonsca    12 年前

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

    如果只希望刷新数据透视,我建议使用该选项

    Sub RefreshPivotTables()     
      Dim pivotTable As PivotTable     
      For Each pivotTable In ActiveSheet.PivotTables         
        pivotTable.RefreshTable     
      Next 
    End Sub 
    
        4
  •  8
  •   Steve WahWah Weeks    13 年前

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

    区别是什么?创建新的透视表时,系统会询问您是否希望基于上一个表。如果您选择否,这个透视表将获得自己的缓存,并使源数据的大小加倍。如果您选择“是”,您将保持工作簿较小,但会添加到共享单个缓存的透视表集合中。刷新该集合中的任何单个透视表时,将刷新整个集合。因此,您可以想象刷新工作簿中的每个缓存与刷新工作簿中的每个透视表之间的区别。

        5
  •  5
  •   Prasenjit    16 年前

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

    按ctrl+alt+f5

        6
  •  1
  •   LohanJ    16 年前

    你有一个 数据透视表 VB上的集合 工作表 对象。因此,这样的快速循环将起作用:

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

    沟渠注释:

    1. 在更新数据透视表之前,请记住取消保护所有受保护的工作表。
    2. 经常保存 .
    3. 我会考虑更多并及时更新…:)

    祝你好运!

        7
  •  0
  •   HaveNoDisplayName    9 年前

    代码

    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
  •  0
  •   Rajiv Singh    9 年前

    偶数 我们可以刷新特定的连接 然后它将刷新所有链接到它的数据透视。

    对于此代码,我已根据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
  •  -1
  •   RBhandal    12 年前

    我最近使用了下面列出的命令,它看起来工作正常。

    ActiveWorkbook.RefreshAll
    

    希望有帮助。

        10
  •  -2
  •   Karuna    12 年前

    如果您使用的是MS Excel 2003,请从此工具栏转到“查看”->工具栏->透视表,我们可以通过单击进行刷新!这个符号。

    推荐文章