如何使用宏刷新我excel工作簿中的所有數據透視表？

Question

我有一個包含20個不同數據透視表的工作簿。有沒有簡單的方法來找到所有的數據透視表並在VBA中刷新它們？

Answer 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 

Answer 2

你有數據透視表收集的VB 工作表對象。所以，一個快速循環這樣將工作：

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

注意從戰壕：

1. 記住在更新數據透視表之前解除對任何受保護的表。
2. 經常保存。
3. 我會想更多的和更新在適當的時候... :)

祝你好運！

Answer 3

此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按鈕

這將刷新數據透視表每個打開工作簿時。

Answer 4

數據透視表工具欄中有刷新全部選項。足夠了。不必做任何事情。

按Ctrl + Alt + F5

Answer 5

在某些情況下，你可能需要一個數據透視表和其PivotCache區分。 Cache擁有自己的刷新方法和自己的集合。所以我們可以刷新所有的PivotCaches而不是數據透視表。

區別？當你創建一個新的數據透視表時，你會根據以前的表格詢問你是否需要它。如果你說不，這個數據透視表得到它自己的緩存並且使源數據的大小加倍。如果您說「是」，您可以保持WorkBook的小型化，但可以添加共享單個緩存的數據透視表集合。刷新該集合中的任何單個數據透視表時，將刷新整個集合。因此，您可以設想，刷新WorkBook中的每個緩存與刷新WorkBook中的每個數據透視表之間可能存在什麼區別。

Answer 6

如果您使用MS Excel 2003，然後轉到查看 - >工具欄 - >數據透視表從這個工具欄，我們可以通過點擊刷新！這個符號。

Answer 7

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

ActiveWorkbook.RefreshAll 

希望有幫助。

Answer 8

ActiveWorkbook.RefreshAll刷新所有內容，不僅是數據透視表，還有ODBC查詢。我有一對夫婦VBA查詢引用數據連接和使用此選項崩潰的命令運行，而不從VBA

提供我推薦的選擇，如果你只是想刷新

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

樞軸的詳細數據連接

Answer 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 

工作正常。

該代碼用於激活表單模塊，因此激活表單時會顯示閃爍/毛刺。

Answer 10

即使我們可以刷新特定的連接，反過來它會刷新鏈接到它的所有樞紐。

對於這個代碼我已經在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