Question

我目前有以下宏来加载网页：

Sub OOS_Query()
'This together with the True value at the end will tell the macro to not update the screen until it reaches a point that I want it to show updates again
Application.ScreenUpdating = False
ActiveWorkbook.Connections("Connection1").Delete
Sheet2.Range("A:C").Clear
With Sheet2.QueryTables.Add(Connection:= _
"URL;http://[ommitted on purpose]id=42908", Destination:=Sheet2.Range("$A$1"))
.FieldNames = True
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.RefreshPeriod = 5
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "1,2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=True

End With
Application.ScreenUpdating = True
End Sub

正如您所看到的，网页上有一个＆＃34; id＆＃34;在查询数据库时不断变化的值。该值在网页的来源中如下所示：

Date <select name="id">
<option value='43032' >2017-05-13 05:00:01</option>
<option value='43031' >2017-05-13 04:45:02</option>
<option value='43030' >2017-05-13 04:30:01</option>
<option value='43029' >2017-05-13 04:15:02</option>

...

<option value='43004' >2017-05-12 22:00:01</option>

我正在寻找一种方法来集成代码，只要时间在21:58:00到22:02:00之间就可以用任何id来拉取网站;无论当前日期是什么。通常这样做的方法是访问网站并从下拉菜单中选择我们想要查询的日期/时间，然后将网站粘贴到上面代码的部分。

如果我可以自动执行此操作，它将删除我每天必须编辑代码。

提前致谢！

Answer 1

我调整了代码以查询网页，但是从我指定的工作表中的单元格中提取ID值。然后我还在代码上添加了更多内容。

ID很容易理解，因为我每天晚上10点（22小时）都需要它，然后我知道无论什么价值都会增加数字96. 96 =值变化的次数假设它们每15分钟改变一次，每小时改变24小时（1小时内改变4次）。所以24次24次给我96，我今天晚上10点添加到ID。

然后我只需要构建2列，其中ID考虑到我上面所说的内容，另一列带有日期。然后我在一个虚拟单元格上构建了一个数组公式，该公式根据当天匹配给出了我正在寻找的id值。代码如下所示：

Sub OOS_Query()

Application.ScreenUpdating = False
ActiveWorkbook.Connections("Connection1").Delete
Sheet2.Range("A:C").Clear

Dim wb As Workbook
Dim src As Worksheet
Dim url As String
Dim symbol As String

Set wb = ThisWorkbook
Set src = wb.Sheets("OldTime")
symbol = src.Range("K2")
url = "URL;[omitted on purpose]="
url = url & symbol

With Sheet2.QueryTables.Add(Connection:= _
url, _
Destination:=Sheet2.Range("$A$1"))
.FieldNames = True
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.RefreshPeriod = 5
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "1,2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=True

End With
Application.ScreenUpdating = True
End Sub

Excell公式：

INDEX(I:I,MATCH(TODAY(),J:J,0))

希望这可以帮助那些可能有类似问题的人。

拉动网页的特定选项值需要VBA宏

1 个答案: