怎样导出网页的多页数据到excel

longhgc

如http://quote.stockstar.com/Comment/5_1_1.html
怎样导出网页的多页数据到excel，
请高手指点下，谢谢

longhgc

请问我这里那里出错了？应如何改？
Sub AA()
    Dim arr(1 To 100000, 1 To 6)
    Cells.ClearContents
    Set oDoc = CreateObject("htmlfile")
    [a1:f1] = Array("序号", "代码", "简称", "千股千评", "收盘价", "涨跌幅")

    With CreateObject("MSXML2.XMLHTTP")
        For p = 1 To 115
            .Open "GET", "http://quote.stockstar.com/Comment/5_1_" & i & ".html", False
            .Send
            oDoc.body.innerHTML = StrConv(.responsebody, vbUnicode)
            Set r = oDoc.All.tags("table")(30).Rows
            For i = 0 To r.Length - 1
                k = k + 1
                For x = 1 To 6
                    arr(k, x) = r(i).Cells(x - 1).innerText
                Next
            Next
            Set r = Nothing
        Next
    End With
    Range("A2").Resize(k, 6) = arr
End Sub

duquancai

longhgc 发表于 2018-8-11 16:02
请问我这里那里出错了？应如何改？
Sub AA()
    Dim arr(1 To 100000, 1 To 6)

看不出你哪里错了，你根本没错！

akak2018

求解？？？？？

xyxcc177

下载工具////

719404338

1. Sub t()
   
2. Dim arr, i%, j%, p%
   
3.       On Error Resume Next
   
4.        [a1] = "序号"
   
5.        [b1] = "代码"
   
6.        [c1] = "简称"
   
7.        [d1] = "千股千评"
   
8.        [e1] = "收盘价"
   
9.        [f1] = "涨跌幅"
   
10.      [a2:f4000].Clear
    
11.      With CreateObject("Microsoft.XMLHTTP")
    
12.      p = 2
    
13.       For j = 1 To 115
    
14.              .Open "GET", "http://quote.stockstar.com/Comment/5_1_" & j & ".html", True
    
15.              .Send
    
16.              Do Until .ReadyState = 4
    
17.                  DoEvents
    
18.              Loop
    
19.              arr = Split(StrConv(.responsebody, vbUnicode, &H804), "<tr><td class=")
    
20.              For i = 1 To 30
    
21.              Cells(p, 1) = Split(Split(arr(i), ">")(1), "<")(0)
    
22.              Cells(p, 2) = Split(Split(arr(i), ">")(3), "<")(0)
    
23.              Cells(p, 3) = Split(Split(arr(i), ">")(6), "<")(0)
    
24.              Cells(p, 4) = Split(Split(arr(i), ">")(9), "<")(0)
    
25.              Cells(p, 5) = Split(Split(arr(i), ">")(12), "<")(0)
    
26.              Cells(p, 6) = Split(Split(arr(i), ">")(16), "<")(0)
    
27.           p = p + 1
    
28.          Next i
    
29.        Next j
    
30.      End With
    
31.      End Sub

复制代码

longhgc

719404338 发表于 2018-8-12 16:54

多谢大哥的指点。收藏了，非常谢谢

longhgc

xyxcc177 发表于 2018-8-12 11:34
下载工具////

大哥是什么工具？怕中毒，能上图说明下吗？

pzpz5566

xyxcc177 发表于 2018-8-12 11:34
下载工具////

这个工具能不能有改网页的功能啊

longhgc

719404338 发表于 2018-8-12 16:54

             Cells(p, 1) = Split(Split(arr(i), ">")(1), "<")(0)
             Cells(p, 2) = Split(Split(arr(i), ">")(3), "<")(0)
             Cells(p, 3) = Split(Split(arr(i), ">")(6), "<")(0)
             Cells(p, 4) = Split(Split(arr(i), ">")(9), "<")(0)
             Cells(p, 5) = Split(Split(arr(i), ">")(12), "<")(0)
             Cells(p, 6) = Split(Split(arr(i), ">")(16), "<")(0)
请问这里面的1，3，6，9，12，16如何得出来的？？