需要将单元格中的数据拆分到不同的列中，并帮助使用vba将数据从网站复制到excel中
需要将单元格中的数据拆分到不同的列中，并帮助使用vba将数据从网站复制到excel中
提问于 2018-06-09 02:56:47
所以我从this网站上复制了流量数据。
到目前为止，我已经使用了以下代码：
Sub main()
Dim IE As InternetExplorer
Dim i
Set IE = New InternetExplorer
IE.Navigate "https://www.cp24.com/mobile/commuter-centre/traffic"
Do
DoEvents
Loop Until IE.ReadyState = ReadyState_Complete
Dim Doc As HTMLDocument
Set Doc = IE.Document
Dim AllRoute As String
Set holdingsClass =
Doc.getElementsByClassName("trafficWidget")
ActiveSheet.Range("A1").Value = holdingsClass(0).textContent
IE.Quit
End Sub我面临着两个问题
1)它将流量小部件类中的所有数据复制到一个像元中，以便在像元空间不足时删除数据
2)我想要一种拆分数据的方法，以便现在所有内容都显示在一个单元格中
它应该看起来像这样
col.A col.B col.C col.D
HighwayName Current Ideal Delay如果有任何建议，我们将不胜感激。
回答 1
Stack Overflow用户
回答已采纳
发布于 2018-06-09 03:09:22
在这里，您可以使用CSS selectors来定位所需的信息。
Option Explicit
Sub Getinfo()
Dim http As New XMLHTTP60, html As New HTMLDocument '< XMLHTTP60 is for Excel 2016 so change according to your versione.g. XMLHTTP for 2013
Const URL As String = "https://www.cp24.com/mobile/commuter-centre/traffic"
Application.ScreenUpdating = False
With http
.Open "GET", URL, False
.send
html.body.innerHTML = .responseText
End With
Dim routeNodeList As Object, currentNodeList As Object, idealNodeList As Object, delayNodeList As Object
With html
Set routeNodeList = .querySelectorAll(".location")
Set currentNodeList = .querySelectorAll(".current")
Set idealNodeList = .querySelectorAll(".ideal")
Set delayNodeList = .querySelectorAll(".delaymin")
End With
Dim i As Long
For i = 0 To routeNodeList.Length - 1
With ActiveSheet
.Cells(i + 2, 1) = routeNodeList.item(i).innerText
.Cells(i + 2, 2) = currentNodeList.item(i).innerText
.Cells(i + 2, 3) = idealNodeList.item(i).innerText
.Cells(i + 2, 4) = delayNodeList.item(i).innerText
End With
Next i
Application.ScreenUpdating = True
End Sub所需的引用(VBE >工具>引用)：
HTML Object library and MS XML < your version输出示例：
后期绑定版本：
Option Explicit
Public Sub Getinfo()
Dim http As Object, html As Object, i As Long
Const URL As String = "https://www.cp24.com/mobile/commuter-centre/traffic"
Application.ScreenUpdating = False
With CreateObject("MSXML2.serverXMLHTTP")
.Open "GET", URL, False
.send
Set html = CreateObject("HTMLFile")
html.body.innerHTML = .responseText
End With
Dim counter As Long: counter = 1
With ActiveSheet
For i = 0 To html.all.Length - 1
Select Case html.all(i).className
Case "location"
counter = counter + 1
.Cells(counter, 1).Value = html.all(i).innerText
Case "current"
.Cells(counter, 2).Value = html.all(i).innerText
Case "ideal"
.Cells(counter, 3).Value = html.all(i).innerText
Case "delaymin"
.Cells(counter, 4).Value = html.all(i).innerText
End Select
Next i
End With
Application.ScreenUpdating = True
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/50766880
复制相关文章
相似问题