本文介绍了从天气网站 HTML 解析平均温度的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!
问题描述
我想使用 VBA 从天气网站提取数据.我想要做的是从这个 HTML 代码中获得数字 6:
Hi I want to use VBA to pull data from weather web site. What I'm trying to do is to get number 6 from this HTML code:
</tr>
<tr>
<td class="indent"><span>Temperatura średnia</span></td>
<td>
<span class="wx-data"><span class="wx-value">6</span><span class="wx-unit"> ° C</span></span>
</td>
<td>
-
</td>
<td> </td>
</tr>
<tr>
<td class="indent"><span>Temperatura maksymalna</span></td>
<td>
<span class="wx-data"><span class="wx-value">7</span><span class="wx-unit"> ° C</span></span>
</td>
<td>
<span class="wx-data"><span class="wx-value">8</span><span class="wx-unit"> ° C</span></span>
</td>
我尝试过这样的代码:
Private Sub CommandButton1_Click()
Dim IE As Object
' Create InternetExplorer Object
Set IE = CreateObject("InternetExplorer.Application")
' You can uncoment Next line To see form results
IE.Visible = False
' URL to get data from
IE.Navigate "https://www.wunderground.com/history/airport/EPGD/2016/10/24/DailyHistory.html?req_city=Pruszcz%20Gdanski&req_statename=Polska&reqdb.zip=00000&reqdb.magic=86&reqdb.wmo=12140"
' Statusbar
Application.StatusBar = "Loading, Please wait..."
' Wait while IE loading...
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
Application.StatusBar = "Searching for value. Please wait..."
Dim dd As String
dd = IE.Document.getElementsByClassName("Temperatura średnia")(0).innerText
MsgBox dd
' Show IE
IE.Visible = True
' Clean up
Set IE = Nothing
Application.StatusBar = ""
End Sub
没有任何结果(代码什么都不做).我将不胜感激.
Without any result (the code does nothing). I will appreciate any help.
推荐答案
以下是使用 XHR 和 RegEx 从网页中检索所有表格数据的示例:
Here is the example using XHR and RegEx to retrieve all table data from the webpage:
Option Explicit
Sub ExtractDataWunderground()
Dim aResult() As String
Dim sContent As String
Dim i As Long
Dim j As Long
' retrieve html content
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://www.wunderground.com/history/airport/EPGD/2016/10/24/DailyHistory.html", False
.Send
sContent = .ResponseText
End With
' parse with regex
With CreateObject("VBScript.RegExp")
.Global = True
.MultiLine = True
.IgnoreCase = True
' minor html simplification
.Pattern = "<span[^>]*>|</span>|[
]*"
sContent = .Replace(sContent, "")
' match each table row
.Pattern = "<tr><td class=""indent"">(.*?)</td><td>(.*?)</td><td>(.*?)</td><td>(.*?)</td></tr>"
With .Execute(sContent)
ReDim aResult(1 To .Count, 1 To 4)
' each row
For i = 1 To .Count
With .Item(i - 1)
' each cell
For j = 1 To 4
aResult(i, j) = DecodeHTMLEntities(.SubMatches(j - 1))
Next
End With
Next
End With
End With
' output result
Cells.Delete
Output Cells(1, 1), aResult
MsgBox "Completed"
End Sub
Function DecodeHTMLEntities(sText As String) As String
Static oHtmlfile As Object
Static oDiv As Object
If oHtmlfile Is Nothing Then
Set oHtmlfile = CreateObject("htmlfile")
oHtmlfile.Open
Set oDiv = oHtmlfile.createElement("div")
End If
oDiv.innerHTML = sText
DecodeHTMLEntities = oDiv.innerText
End Function
Sub Output(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize( _
UBound(aCells, 1) - LBound(aCells, 1) + 1, _
UBound(aCells, 2) - LBound(aCells, 2) + 1 _
)
.NumberFormat = "@"
.Value = aCells
.Columns.AutoFit
End With
End With
End Sub
我的输出如下:
要仅提取平均温度,您可以从索引为 0 的第一个匹配项中获取值,因为平均温度位于表的第一行:
To extract the mean temperature only you can get the value from the first match having 0 index, since the mean temperature is in the first row of the table:
Sub ExtractMeanTempWunderground()
Dim sContent As String
' retrieve html content
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://www.wunderground.com/history/airport/EPGD/2016/10/24/DailyHistory.html", False
.Send
sContent = .ResponseText
End With
' parse with regex
With CreateObject("VBScript.RegExp")
.Global = True
.MultiLine = True
.IgnoreCase = True
' minor html simplification
.Pattern = "<span[^>]*>|</span>|[
]*"
sContent = .Replace(sContent, "")
' match each table row
.Pattern = "<tr><td class=""indent"">.*?</td><td>(.*?)</td><td>.*?</td><td>.*?</td></tr>"
With .Execute(sContent)
If .Count = 15 Then
' get the first row value only
MsgBox DecodeHTMLEntities(.Item(0).SubMatches(0))
Else
MsgBox "Data structure inconsistence detected"
End If
End With
End With
End Sub
Function DecodeHTMLEntities(sText As String) As String
Static oHtmlfile As Object
Static oDiv As Object
If oHtmlfile Is Nothing Then
Set oHtmlfile = CreateObject("htmlfile")
oHtmlfile.Open
Set oDiv = oHtmlfile.createElement("div")
End If
oDiv.innerHTML = sText
DecodeHTMLEntities = oDiv.innerText
End Function
注意,这种方法会一直工作到网页结构改变.
Note, such methods will work until the webpage structure is changed.
这篇关于从天气网站 HTML 解析平均温度的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!