我尝试通过xmlhttp GET从网站获取数据。遗憾的是,表中一行或一列中没有恒定数量的列,因为某些单元格已合并(我甚至不得不在宏中手动将最大列数更改为11,因为第一行的列数较少)。 / p>
我希望输出与网站完全一样。
Option Explicit
Public Sub GetTable()
Dim oDom As Object: Set oDom = CreateObject("htmlFile")
Dim x As Long, y As Long
Dim oRow As Object, oCell As Object
Dim vData As Variant
Dim link As String
link = "http://medicarestatistics.humanservices.gov.au/statistics/do.jsp?_PROGRAM=%2Fstatistics%2Fmbs_group_standard_report&DRILL=on&GROUP=Broad+Type+of+Service+%28BTOS%29&VAR=services&STAT=count&RPT_FMT=by+time+period+and+state&PTYPE=month&START_DT=201609&END_DT=201609"
y = 1: x = 1
With CreateObject("msxml2.xmlhttp")
.Open "GET", link, False
.Send
oDom.body.innerHtml = .responseText
End With
With oDom.getelementsbytagname("table")(0)
ReDim vData(1 To .Rows.Length, 1 To 11) '.Rows(1).Cells.Length)
For Each oRow In .Rows
For Each oCell In oRow.Cells
vData(x, y) = oCell.innerText
y = y + 1
Next oCell
y = 1
x = x + 1
Next oRow
End With
Sheets(1).Cells(1, 1).Resize(UBound(vData), UBound(vData, 2)).Value = vData
End Sub
答案 0 :(得分:1)
每次通过循环检查行长度,如果需要更多列,请调整数组大小:
With oDom.getelementsbytagname("table")(0)
Dim rowCount As Long
rowCount = .Rows.Length
ReDim vData(1 To rowCount, 1 To .Rows(0).Cells.Length)
For Each oRow In .Rows
Dim columnCount As Long
columnCount = .Rows(x - 1).Cells.Length
If columnCount > UBound(vData, 2) Then
ReDim Preserve vData(1 To rowCount, 1 To columnCount)
End If
For Each oCell In oRow.Cells
vData(x, y) = oCell.innerText
y = y + 1
Next oCell
y = 1
x = x + 1
Next oRow
End With
修改强>
未检查源表中的列跨度。一种选择是使用@ Thunderframe的建议和测试所有列跨度,但这似乎有点单调乏味。我个人利用Excel知道如何从剪贴板粘贴HTML的事实,让Excel弄清楚:
With oDom.getelementsbytagname("table")(0)
Dim dataObj As Object
Set dataObj = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
dataObj.SetText "<table>" & .innerHtml & "</table>"
dataObj.PutInClipboard
End With
Sheets(1).Paste Sheets(1).Cells(1, 1)