Question

我正尝试将此脚本中的数据从java脚本生成的表导入Excel 2010：https://spotwx.com/products/grib_index.php?model=nam_awphys&lat=30.26678&lon=-97.76905&tz=America/Chicago&display=table

我的代码（我从另一篇文章中窃取并已更改）如下：

Sub SpotWx_NAM()

Dim xmlHttp As Object
Dim TR_col As Object, TR As Object
Dim TD_col As Object, TD As Object
Dim row As Long, col As Long

Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
xmlHttp.Open "GET", "https://spotwx.com/products/grib_index.php?model=nam_awphys&lat=55.81035&lon=-122.26822&tz=America/Dawson_Creek&display=table", False
xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.send

Dim html As Object
Set html = CreateObject("htmlfile")
html.body.innerHTML = xmlHttp.responseText

Dim tbl As Object
Set tbl = html.getElementById("example")

row = 1
col = 1

Set TR_col = html.getElementsByTagName("TR")
For Each TR In TR_col
    Set TD_col = TR.getElementsByTagName("TD")
    For Each TD In TD_col
        Cells(row, col) = TD.innerText
        col = col + 1
    Next
    col = 1
    row = row + 1
Next
End Sub

提前致谢！

Answer 1

数据不存储在传统的HTML表格中，因此您必须进行一些数据体操。我建议利用正则表达式去除所需的数据，然后解析结果。下面的代码将通过向您展示数组中的每一行来为您提供部分方法。我会留给你分享＆＃39;每个结果行相应地通过迭代行数组得到每个项目。您还需要修剪第一个和最后一个数组项的方括号。

Sub SpotWx_NAM()

Dim xmlHttp As Object
Dim TR_col As Object, TR As Object
Dim TD_col As Object, TD As Object
Dim row As Long, col As Long

Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
xmlHttp.Open "GET", "https://spotwx.com/products/grib_index.php?model=nam_awphys&lat=55.81035&lon=-122.26822&tz=America/Dawson_Creek&display=table", False
xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.send

Dim html As Object
Set html = CreateObject("htmlfile")
html.body.innerHTML = xmlHttp.responseText

Dim rowsArr As Variant
rowsArr = Split(extractRows(xmlHttp.responseText), "],[", -1, 0)
For i = 0 To UBound(rowsArr)
Sheets(1).Range("A1").Resize(, UBound(rowsArr)).Offset(i) = Split(rowsArr(i), "','")
Next
End Sub

Function extractRows(ByVal text As String) As Variant
Dim matches As Object
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
Dim arr() As Variant
Dim result As Variant

RE.Pattern = "\['.*'\]"
RE.Global = True
RE.IgnoreCase = True
Set matches = RE.Execute(text)

extractRows = matches(0)
End Function

这会将您的数据输出到表1中，您需要将其清理一下。从第一个和第一个删除支架最后一个单元格和一个＆＃39;来自末端细胞。

Excel从java表导入数据

1 个答案: