Question

我遇到的问题是，在完成所有任务后，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

Answer 1

有趣的是，我想尝试一种替代方法来实现数据透视表 -

  ActiveWorkbook.RefreshAll

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

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

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

1 个答案: