Question

我几周前刚刚开始学习VBA，所以如果我的工作有任何明显的错误我会道歉。我已经编写了一些成功从网站上的表中删除数据的代码，问题是它运行得非常慢。我知道使用internetexplorer.application是一种非常缓慢的网站抓取方式，更快捷的方法是使用MSXML2.XMLHTTP。

所以我试图将我当前的代码转换为使用MSXML2.XMLHTTP而不是internetexplorer.application，但我似乎弄得一团糟。我搜索了很多问题，但我似乎遇到了像.getElementsByTagName这样的问题。

这是我想要转换为MSXML2.XMLHTTP的internetexplorer.application代码

Sub macro6()

Dim internet As InternetExplorer

Dim internetdata As HTMLDocument

Dim internetlink As Object
Dim bbb As Long
Dim internetinnerlink As Object
Dim LR As Long
    LR = Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row
Dim LR2 As Long
    LR2 = Sheets("Sheet1").Range("H" & Rows.Count).End(xlUp).Row + 1
Dim LC As Long
    LC = Sheets("Sheet1").Cells(2, Columns.Count).End(xlToLeft).Column + 1
Dim y As Long


For bbb = 1 To (LR - 1)
Set internet = CreateObject("InternetExplorer.Application")


internet.Visible = False

internet.navigate ("http://data.nowgoal.com/3in1odds/31_" & Sheets("Sheet1").Range("c1").Offset(bbb, 0)) & ".html"

Do While internet.Busy

  DoEvents

Loop

Do Until internet.READYSTATE = READYSTATE_COMPLETE

  DoEvents

Loop

Set internetdata = internet.document
For y = 2 To 4

hg_blue = internetdata.getElementsByTagName("tbody")(y).getElementsByClassName("hg_blue").Length + 1
hg_red = internetdata.getElementsByTagName("tbody")(y).getElementsByClassName("hg_red").Length
hg_green = internetdata.getElementsByTagName("tbody")(y).getElementsByClassName("hg_green").Length

xx = hg_blue + 1
yy = hg_blue + hg_red
zz = hg_blue + hg_red + hg_green

If zz > 1 Then

    Set internetlink = internetdata.getElementsByTagName("tbody")(y).getElementsByTagName("tr")(xx).getElementsByTagName("td")
    Set internetlink2 = internetdata.getElementsByTagName("tbody")(y).getElementsByTagName("tr")(yy).getElementsByTagName("td")
    Set internetlink3 = internetdata.getElementsByTagName("tbody")(y).getElementsByTagName("tr")(zz).getElementsByTagName("td")


    For Each internetinnerlink In internetlink
    Sheets("Sheet1").Cells(LR2, LC) = internetinnerlink.innerText

    LC = LC + 1
    Next internetinnerlink


    For Each internetinnerlink In internetlink2
    Sheets("Sheet1").Cells(LR2, LC) = internetinnerlink.innerText

    LC = LC + 1
    Next internetinnerlink


    For Each internetinnerlink In internetlink3
    Sheets("Sheet1").Cells(LR2, LC) = internetinnerlink.innerText

    LC = LC + 1
    Next internetinnerlink

Else

    Set internetlink = internetdata.getElementsByTagName("tbody")(y).getElementsByTagName("tr")(1).getElementsByTagName("td")
    Set internetlink2 = internetdata.getElementsByTagName("tbody")(y).getElementsByTagName("tr")(1).getElementsByTagName("td")
    Set internetlink3 = internetdata.getElementsByTagName("tbody")(y).getElementsByTagName("tr")(1).getElementsByTagName("td")


    For Each internetinnerlink In internetlink
    Sheets("Sheet1").Cells(LR2, LC) = ""

    LC = LC + 1
    Next internetinnerlink


    For Each internetinnerlink In internetlink2
    Sheets("Sheet1").Cells(LR2, LC) = ""

    LC = LC + 1
    Next internetinnerlink


    For Each internetinnerlink In internetlink3
    Sheets("Sheet1").Cells(LR2, LC) = ""

    LC = LC + 1
    Next internetinnerlink

End If

Next y
LR2 = LR2 + 1
LC = Sheets("Sheet1").Cells(LR2, Columns.Count).End(xlToLeft).Column + 1

internet.Quit
Next bbb


End Sub

C列中的数据是C2中的数字1274444，C3中的1274445，C4中的1274446等。

从头开始并再次编写代码或者我可以进行简单的更改是否更容易？谢谢你的帮助。

如何使用MSXML2.XMLHTTP而不是InternetExplorer.Application

0 个答案: