如何使用刷新将 Excel Web 数据添加到新列或工作表中而不覆盖旧数据

Question

我正在使用 Excel 的 Web 数据将值表从网站移动到 Excel。我的刷新周期是每 10 分钟一次。我的目的刷新的问题是它用新值覆盖旧值。我需要保留每 10 分钟获取的表数据（我将绘制此图），因此值的进展很重要（不仅仅是当前值是什么）。我会在工作时运行它，所以它必须是自动化的。

最好将数据添加到单个工作表中，但如果它需要一个带有每个数据转储的新工作表，那也没关系。

有谁知道 Excel Web Data 是否可以做到这一点？或者类似的东西？VBA 已经过时了，因为 HTML 太难导航（对我来说），而且表格有太多我需要调用和迭代的唯一字段。

谢谢，

TMME

Answer 1

Excel 的 Web 查询工具无法保留以前获取的数据。

但是，使用 VBA，每次 Web 查询刷新 Excel 中的查询表时，可以很容易地自动复制查询表中的数据。

请按照以下步骤设置工作簿来演示该技术：

1）创建一个包含两个工作表的新工作簿，WebQuery并且USD.

2) 选择A1工作表的单元格WebQuery并使用地址启动新的 Web 查询https://www.xe.com/currencyconverter/。

3) 向下滚动到 XE 实时汇率表并将其导入。

4）在ThisWorkbook模块中添加以下代码：

'============================================================================================
' Module     : ThisWorkbook
' Version    : 0.1.0
' Part       : 1 of 2
' References : N/A
' Source     : https://superuser.com/a/1331097/763880
'============================================================================================
Option Explicit

Private qtExchangeRates As New clsQueryTable

Private Sub Workbook_Open()

  qtExchangeRates.InitEvents Worksheets("WebQuery").QueryTables(1)

End Sub

5) 创建一个名为的新类模块clsQueryTable并将以下代码放入其中：

'============================================================================================
' Module     : Class Module clsQueryTable
' Version    : 0.1.0
' Part       : 2 of 2
' References : N/A
' Source     : https://superuser.com/a/1331097/763880
'============================================================================================
Option Explicit

Public WithEvents QueryTable As QueryTable

Private Sub QueryTable_AfterRefresh(ByVal Success As Boolean)

  If Success Then
    Dim varUSDExchangeRates As Variant
    varUSDExchangeRates = Me.QueryTable.WorkbookConnection.Ranges(1).Columns(2).Value2
    varUSDExchangeRates(LBound(varUSDExchangeRates), 1) = Now
    Worksheets("USD").Range("A1").Offset(Rows.Count - 1).End(xlUp).Offset(1) _
      .Resize(ColumnSize:=1 + UBound(varUSDExchangeRates) - LBound(varUSDExchangeRates)) _
      = Excel.WorksheetFunction.Transpose(varUSDExchangeRates)
  Else
    ' Query failed or was cancelled
  End If

End Sub

Sub InitEvents(QueryTable As Object)

  Set Me.QueryTable = QueryTable

End Sub

6) 将 Web 查询设置为每分钟自动刷新一次。

7）保存并关闭工作簿

当您重新打开工作簿时，Web 查询将开始每分钟刷新一次，XE 实时汇率表的第一个数据列（当前美元汇率）将存储在工作表中USD。

该演示仅提取一列数据，但可以以相同的方式复制任何/所有表的数据。

请注意，该演示将像来自任何URL 的任何表一样正常工作，因为代码会自动调整表的大小。