[英]Excel Dynamic Web query specific data from table and transpose the result using VBA code
我正在尝试在 excel 中编写宏到 web 查询多个站点以从表中检索特定数据。 web 查询在 A 列中获取数据,并在 C 列中显示结果。 问题是表格显示在几行中,我只需要两行(日期和价格); rest 被删除。 结果应在 B 列和 C 中转置。(每小时刷新一次)。 查询如何注意获取所需数据并循环运行 A 列中的其他行并显示在 C 和 D 中。感谢帮助和支持,因为我是 VBA 的新手
A B c D
Site Date/Time Price
74156 xxx yyy
85940
....
....
代码如下
Sub test1()
Dim qt As QueryTable
Set qt = ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.petro-canada.ca/en/locations/4085.aspx?MODE=DTS&ID=" & Range("A2").Value, Destination:=Range("c2"))
With qt
.Name = "Regular, Posted, Self serve"
.WebSelectionType = xlSpecifiedTables
.WebTables = "20" ' Regular table
.WebFormatting = xlWebFormattingNone
.EnableRefresh = True
.RefreshPeriod = 60 'Unit in minutes
.Refresh 'Execute query
End With
结束子
将您的 web 查询放在不同的页面上,然后在每次刷新时将您需要的数据拉到您的列表中。 这是一个例子。
Sub GetPrices()
Dim rCell As Range
Dim lIDStart As Long
Dim qt As QueryTable
Const sIDTAG = "&ID="
Application.EnableEvents = False
Set qt = Sheet1.QueryTables(1)
'loop through site IDs
For Each rCell In Sheet2.Range("A2:A3").Cells
'find the id parameter in the web query connection
lIDStart = InStr(1, qt.Connection, sIDTAG)
'if found, change the ID
If lIDStart > 0 Then
qt.Connection = Left$(qt.Connection, lIDStart - 1) & sIDTAG & rCell.Value
Else 'if not found, add the id onto the end
qt.Connection = qt.Connection & sIDTAG & rCell.Value
End If
'refresh the query table
On Error Resume Next
qt.Refresh False
'if the web query worked
If Err.Number = 0 Then
'write the date
rCell.Offset(0, 1).Value = Sheet1.Range("A2").Value
'write the price
rCell.Offset(0, 2).Value = Sheet1.Range("A4").Value
Else 'if there was a problem with the query, write an error
rCell.Offset(0, 1).Value = "Invalid Site"
rCell.Offset(0, 2).Value = ""
End If
On Error GoTo 0
Next rCell
Application.EnableEvents = True
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.