Board logo

標題: [發問] 請教這網頁附圖表格是在第幾???(table) [打印本頁]

作者: t8899    時間: 2020-5-8 06:52     標題: 請教這網頁要直接匯入工作表要如何改??

https://tw.stock.yahoo.com/d/i/rank.php?t=up&e=tse
Sub test()
    Set Ie = CreateObject("InternetExplorer.Application")
    Ie.Visible = True
       Ie.Navigate "https://tw.stock.yahoo.com/d/i/rank.php?t=up&e=tse"
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("sheet2")
      .Range("a1:f30").ClearContents
        For S = 2 To 2                    '已找出網頁的table內容在 2 中
            For I = 0 To Element(S).Rows.Length - 1
                k = k + 1
                For J = 0 To Element(S).Rows(I).Cells.Length - 1   '資料的欄位共6位
                .Cells(k, J + 1) = Element(S).Rows(I).Cells(J).innerText
                Next
            Next
        Next

    End With
    Set Element = Nothing
               
Ie.Quit
End Sub
作者: t8899    時間: 2020-5-8 08:39

已解決...........
作者: t8899    時間: 2020-5-9 16:54     標題: 請教這網頁附圖表格是在第幾???(table)

https://pchome.megatime.com.tw/rank/sto0/ock03.html

請教這網頁附圖表格是在第幾???(table)

[attach]32008[/attach]
作者: GBKEE    時間: 2020-5-10 15:13

本帖最後由 GBKEE 於 2020-5-10 15:20 編輯

回復 3# t8899

  1. Option Explicit
  2. Sub Ex()
  3.     Dim R As Integer, C As Integer
  4.     With New InternetExplorer  '**設定引用項目加入-->   Microsoft Internet Controls***
  5.        .Visible = True
  6.         .Navigate "https://pchome.megatime.com.tw/rank/sto0/ock03.html"
  7.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  8.                      '<table style="margin-top: 10px;" cellspacing="1" cellpadding="0" **網頁的內容**
  9.          With .Document.querySelector("table[style='margin-top: 10px;'][cellspacing='1'][cellpadding='0']")
  10.          '' With .Document.all.tags("table")(0) '** 也可以
  11.             For R = 0 To .Rows.Length - 1
  12.                 For C = 0 To .Rows(R).Cells.Length - 1
  13.                     ActiveSheet.Cells(R + 1, C + 1) = .Rows(R).Cells(C).innerText
  14.                 Next
  15.             Next
  16.         End With
  17.          .Quit
  18.       End With
  19. End Sub
複製代碼

作者: t8899    時間: 2020-5-11 06:12

回復  t8899
GBKEE 發表於 2020-5-10 15:13


又學習到新的抓法, 謝謝指導!




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