[發問] 如何將網頁資料自貼貼於excel表格上

hsueh0926

大家好
我如何可以將網頁資料自動貼於excel呢
網頁如下
http://norway.twsthr.info/StockHolders.aspx?stock=2454
我希望可以於EXCEL的A1欄位填上2454
然後按執行
即可自動將網頁資料貼於excel呢

下載 (87.03 KB)

2015-11-7 16:39

Airman

先看看准大的相關文章~
http://blog.xuite.net/smile1000mile/blog/210628980
http://blog.xuite.net/smile1000mile/blog?st=c&p=1&w=3375724

GBKEE

回復 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

回復 3# GBKEE

跑出的數值似乎都不對
不過還是謝謝您唷

GBKEE

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

下載 (260.97 KB)

2015-11-12 06:48