Board logo

標題: [發問] 如何將網頁資料自貼貼於excel表格上 [打印本頁]
作者: hsueh0926    時間: 2015-11-7 16:40     標題: 如何將網頁資料自貼貼於excel表格上

大家好
我如何可以將網頁資料自動貼於excel呢
網頁如下
http://norway.twsthr.info/StockHolders.aspx?stock=2454
我希望可以於EXCEL的A1欄位填上2454
然後按執行
即可自動將網頁資料貼於excel呢
[attach]22371[/attach]
作者: Airman    時間: 2015-11-7 20:00

本帖最後由 Airman 於 2015-11-7 20:02 編輯

先看看准大的相關文章~
http://blog.xuite.net/smile1000mile/blog/210628980
http://blog.xuite.net/smile1000mile/blog?st=c&p=1&w=3375724
作者: GBKEE    時間: 2015-11-9 08:42

回復 1# hsueh0926
試試看
  1. Option Explicit
  2. Sub Ex() '方法一 純文字
  3.     Dim Sh As Worksheet, i As Integer, k As Integer, R As Variant
  4.     With CreateObject("InternetExplorer.Application")
  5.         .Visible = True
  6.         .Navigate "http://norway.twsthr.info/StockHolders.aspx?stock=2454"
  7.         '資料在 .Document.all.Tags("table")(9)
  8.         Set Sh = ActiveSheet
  9.         Sh.UsedRange.Clear
  10.         Application.StatusBar = "等候網頁中..."
  11.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  12.          Application.StatusBar = "網頁下載完畢...."
  13.          Application.ScreenUpdating = False        
  14.         For Each R In .Document.all.Tags("table")(9).Rows        
  15.             k = k + 1
  16.             For i = 0 To R.Cells.Length - 1
  17.                 Sh.Cells(k, i + 1) = R.Cells(i).innerText
  18.             Next
  19.         Next
  20.         Sh.UsedRange.SpecialCells(xlCellTypeBlanks).Delete
  21.         Application.ScreenUpdating = True
  22.        .Quit
  23.     End With
  24. End Sub
複製代碼
  1. Sub Ex2() '方法二 網頁格式
  2.     With CreateObject("InternetExplorer.Application")
  3.        ' .Visible = True
  4.         .Navigate "http://norway.twsthr.info/StockHolders.aspx?stock=2454"
  5.         Application.StatusBar = "等候網頁中..."
  6.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  7.         Application.ScreenUpdating = False
  8.         Ep .Document.all.Tags("table")(9).outerHTML
  9.         Application.StatusBar = "網頁下載完畢...."
  10.         Application.ScreenUpdating = True
  11.        .Quit
  12.     End With
  13. End Sub
  14. Sub Ep(S As String)
  15.     Dim Sh As Worksheet
  16.     With CreateObject("InternetExplorer.Application")
  17.         .Navigate "about:Tabs"
  18.        ' .Visible = True
  19.         .Document.body.innerHTML = S
  20.         .ExecWB 17, 2       '  Select All
  21.         .ExecWB 12, 2       '  Copy selection
  22.         Set Sh = ActiveSheet
  23.         With Sh
  24.             .Range("A1").Select
  25.             .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=False
  26.         End With
  27.         .Quit
  28.     End With
  29. End Sub
複製代碼
作者: hsueh0926    時間: 2015-11-12 00:02

回復 3# GBKEE

跑出的數值似乎都不對
不過還是謝謝您唷
作者: GBKEE    時間: 2015-11-12 06:48

回復 4# hsueh0926
ie8, 2003資料在 .Document.all.Tags("table")(9)
請修改試找出資料在 .Document.all.Tags("table")(??)


[attach]22406[/attach]



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