Excel Dynamic Web从表中查询特定数据并使用VBA代码转置结果
我正在尝试在Excel中写入macros以查询多个站点以从表中检索特定的数据。 networking查询正在A列中获取数据，并在C列中显示结果。事情是，表格显示在几行，只有两个我需要（date和价格）; rest被删除。 结果应该在B和C列转置（每小时刷新一次）。 如何查询可以小心获取所需的数据，也可以运行在列A中的其他行的循环，并显示在C和D.帮助和支持表示赞赏，因为我是新的VBA
AB 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
结束小组
把你的网页查询放在不同的页面上，然后在每次刷新时把你需要的数据拖到列表中。 这是一个例子。
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
可以在http://www.dailydoseofexcel.com/excel/PetroWeb.xlsfind一个例子