標題: [發問] 抓網頁表格? [打印本頁]

---

作者: t8899    時間: 2022-5-28 06:30     標題: 抓網頁表格?

https://tw.stock.yahoo.com/adr
Sub adr()
    Set Ie = CreateObject("InternetExplorer.Application")
'  Ie.Visible = True
       Ie.Navigate "https://tw.stock.yahoo.com/adr"
Do While Ie.Busy Or Ie.ReadyState <> 4: DoEvents: Loop
    Dim I As Integer, S As Integer, k As Integer, J As Integer
     Dim Element
    Set Element = Ie.document.getelementsbytagname("table")
    With Sheets("sheet1")
            For S = 0 To 5               
            For I = 0 To Element(S).Rows.Length - 1
                k = k + 1
                For J = 0 To Element(S).Rows(I).Cells.Length - 1
                 .Cells(k, J + 1) = Element(S).Rows(I).Cells(J).innerText
                Next
            Next
        Next
    End With
    Set Element = Nothing
Ie.Quit
End Sub

---

作者: lee88    時間: 2022-6-4 18:44

回復 1# t8899

1. Option Explicit
   
2. Sub Ex_奇摩股市ADR()
   
3.     Dim E As Object, i As Integer, R As Integer, C As Integer
   
4.     Dim SH As Worksheet, Span As Object, S As Variant
   
5.     Dim Rng As Range
   
6.     Set SH = Sheets(1)
   
7.     SH.Cells.Clear
   
8.     S = Split("股名/股號,,股價,漲跌,漲跌幅(%),買進,賣出,開盤,昨收,最高,最低,成交量 (股),時間 (CST)", ",")
   
9.     SH.Range("A1").Resize(, UBound(S) + 1) = S
   
10.     With CreateObject("InternetExplorer.Application")
    
11.         .Visible = True
    
12.         .Navigate "https://tw.stock.yahoo.com/adr"
    
13.          Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
    
14.          Set E = .Document.querySelector("ul[class='M(0) P(0) List(n)']").all.tags("LI")
    
15.         For i = 0 To E.Length - 1
    
16.         '***** 元素( LI )  讀取整列.innertext   清除 Chr(13) & Chr(10)  字元  *******************
    
17.      '       S = Replace(E(i).innertext, Chr(13) & Chr(10), "*")
    
18.       '      Do
    
19.        '         S = Replace(S, "**", "*")
    
20.         '    Loop While InStr(S, "**")
    
21.          '   S = Split(Mid(S, 2), "*")
    
22.           '  With SH.Cells(i + 2, 1).Resize(, UBound(S) + 1)
    
23.            ' .Cells = S
    
24.             '.Value = .Value
    
25.            ' End With
    
26.          '***** 元素( LI )下的元素(Span) 讀取整列.innertext   清除空白字元  *******************
    
27.         Set Span = E(i).all.tags("span")
    
28.            Set Rng = SH.Range("a" & i + 2)
    
29.             For C = 1 To Span.Length - 1
    
30.                     If Span(C).innertext <> "" Then
    
31.                      Rng = Span(C).innertext
    
32.                      Set Rng = Rng.Offset(, 1)
    
33.                     End If
    
34.             Next
    
35.         Next
    
36.         .Quit        '關閉網頁
    
37.     End With
    
38. End Sub

複製代碼

---

作者: t8899    時間: 2022-6-5 10:10

回復 2# lee88

感謝指導

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)