VBA 在填充数据后更新数据透视表答案

【问题标题】：VBA to update pivot tables after data is populatedVBA 在填充数据后更新数据透视表
【发布时间】：2017-05-15 21:47:15
【问题描述】：

我遇到了一个问题，即 VBA 在完成所有任务后不更新数据透视表。请看下面的代码。它应该更新每个工作表中的所有数据透视表。好像excel忽略了最后一段代码，根本不运行？

    Sub update_data()

    Dim ws As Worksheet
    Dim pt As PivotTable

    Const raw_data_1 As String = "raw_data_1"
    Const raw_data_2 As String = "raw_data_2"
    Const shUpdate As String = "ORP"

OPTIMISE (True)

    ThisWorkbook.Worksheets(raw_data_1).Cells.ClearContents

    If Worksheets(shUpdate).FilterMode = True Then
    With ThisWorkbook.Worksheets(shUpdate)
        .Range("A2:F" & Range("A" & Rows.Count).End(xlDown).Row).ClearContents
        .AutoFilter.Sort.SortFields.Clear
        .ShowAllData
    End With
    Else
    With ThisWorkbook.Worksheets(shUpdate)
        .Range("A2:F" & Range("A" & Rows.Count).End(xlDown).Row).ClearContents
    End With
    End If

    With ThisWorkbook.Worksheets(raw_data_1).QueryTables.Add(Connection:= _
        "URL;https://www.link/", Destination _
        :=Worksheets(raw_data_1).Range("A1"))
        .Name = "packageSummary"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = """ec_table"""
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

    With ThisWorkbook.Worksheets(raw_data_1)
        .Range(.Range("A3"), .Range("A3").End(xlDown)).copy _
            Destination:=Worksheets(shUpdate).Range("A2")
    End With

    With ThisWorkbook.Worksheets(shUpdate)
        .Range(.Range("A2"), .Range("A2").End(xlDown)).TextToColumns _
            Destination:=Range("A2"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
            TrailingMinusNumbers:=True
    End With

    With ThisWorkbook.Worksheets(raw_data_1)
        .Range("D3:D" & Range("D" & Rows.Count).End(xlDown).Row).copy _
            Destination:=Worksheets(shUpdate).Range("D2")
        .Range("F3:F" & Range("F" & Rows.Count).End(xlDown).Row).copy _
            Destination:=Worksheets(shUpdate).Range("E2")
        .Range("G3:G" & Range("G" & Rows.Count).End(xlDown).Row).copy _
            Destination:=Worksheets(shUpdate).Range("F2")
    End With

    ThisWorkbook.Worksheets(raw_data_2).Cells.ClearContents

   With ThisWorkbook.Worksheets(raw_data_2).QueryTables.Add(Connection:= _
      "URL;https://link/", _
         Destination:=Worksheets(raw_data_2).Range("A1"))

      .BackgroundQuery = True
      .TablesOnlyFromHTML = True
      .Refresh BackgroundQuery:=False
      .SaveData = True
   End With

    For Each ws In ThisWorkbook.Worksheets
        For Each pt In ws.PivotTables
            pt.RefreshTable
        Next pt
    Next ws

OPTIMISE False

End Sub

【问题讨论】：

哪一行被忽略了？当你单步执行代码时？
对于 ThisWorkbook.Worksheets 中的每个 ws，如果您在代码底部向下滚动，您会发现应该更新工作簿中每个数据透视表的代码
OPTIMISE 是做什么的？
@Martin 如何使用从QueryTables 收到的更新数据更新您的PivotTable？您需要将PivotCache 设置为SourceData（在您的情况下为QueryTable），然后您可以使用pt.PivotCache.Refresh
正如@ShaiRado 所说 ^ 或者，如果您的数据透视表链接到您的“ORP”表，那么您的问题仅仅是它们仅链接到该表中未更改的数据吗？（例如，可能链接到前 100 行，但您现在正在复制更多数据，这些数据扩展到第 101+ 行）

标签： excel refresh pivot-table vba

【解决方案1】：

有趣的是，我会尝试另一种数据透视表的方法 -

  ActiveWorkbook.RefreshAll

或者如果这不起作用，请尝试遍历所有数据透视表 -

For Each ws In ThisWorkbook.Worksheets
    For Each pt In ws.PivotTables
        pt.PivotCache.Refresh
    Next pt
Next ws

【讨论】：