VBA-Excel将数据从站点复制到Excel – 新build单元格和HTML问题

我将概述我的任务。 我有一个Excel工作表，我希望编写代码指示IE导航到单元格中指定的URL，从网页复制信息并粘贴到Excel。 在IE浏览器的同一窗口中转到Excel中列出的下一个URL，然后粘贴到下一个单元格。

我有代码来到页面等，但所有的HTML是一个表，所以我不能使用Excel的“获取数据”function。 此外，通过此方法检索到的信息不能是“vlookup”。

我相信有一些工作在HTML的父子function来钻取数据，因为此刻它正在复制信息，而且还有表格样式等。

此外，某些信息仅作为指向另一个URL的链接出现在HTML中。 如果我可以使用代码复制产品，而不是build设性的代码将是有用的。

自动select单元格的URL和粘贴信息也有一个问题。 我需要写每个实例吗？ 将有大约400个请求。

该URL是UN＆PW保护，但我可以粘贴HTML元素来帮助。

非常感谢。

这是我迄今为止：

Private Sub blahblah_Click() Dim ie As Object Dim WB As Workbook Dim WS As Worksheet Set WB = Workbooks("hopef.xlsm") Set WS = WB.Sheets("Sheet1") Set ie = CreateObject("InternetExplorer.Application") With ie .Visible = True For Each URL In Range("A2") .Navigate URL.Value Do While ie.Busy Application.Wait DateAdd("s", 1, Now) Loop Application.Wait DateAdd("s", 1, Now) p = ie.Document.getelementbyid("adviser_fund_wrapper").innerHTML WS.Range("B1").Value = p Next With ie .Visible = True For Each URL In Range("A3") .Navigate URL.Value Do While ie.Busy Application.Wait DateAdd("s", 1, Now) Loop y = ie.Document.getelementbyid("scheme_assets").innerHTML WS.Range("c1").Value = y Application.Wait DateAdd("s", 1, Now) y = ie.Document.getelementbyid("adviser_fund_wrapper").innerHTML WS.Range("d1").Value = y Next End With End With End Sub 

Answer 1

我不确定你到底在做什么。 此外，这可能不是正确的答案和太长的评论，因此张贴为答案。

这里有些伪：

 Open the browser loop through the cells contain URL values Navigate to the url Search and find the value in the html section paste the value in the result column next to the URL column (like if url column is A3, result column will be .Range("C" & loopCounter)) Search another value in HTML and paste on another result column loop end 

关于父循环中的迭代。 循环直到findRange中的空单元（“A：A”）

Answer 2

这里是我用来做类似的一些代码，你只需要修改它，使其工作！

 Dim dataextract As String Do Until IsEmpty(ActiveCell) With ObjIE .navigate ActiveCell.Value End With objIE.Visible = False Do While objIE.readyState <> 4 And objIE.Busy DoEvents Loop 'Do While objIE.readyState > 4: Loop 'Call Sleep Application.Wait (Now + TimeValue("0:00:01")) On Error Resume Next dataextract = objIE.document.getElementsByTagName(Putstuffhere) If objIE.document.getElementsByTagName(Putstuffhere).innerText <> " " Then Do code. Else Do different code End If ActiveCell.Offset(0, 1).Value = dataextract ActiveCell.Offset(1, 0).Select Application.Wait (Now + TimeValue("0:00:01")) Loop 

这个代码一旦编辑完毕，就会把特定的数据拉回到你的input数据相邻的单元格中，并循环直到完成。