12345
返回列表 上一主題 發帖

[發問] 一個用VBA從網頁取得想要資料的寫法~

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
21# 跳轉到 »
發表於 2014-1-22 14:15 | 只看該作者
回復 20# norafang
你要用IE匯入外部資料是無法用錄製,
功能表指令:資料-> 匯入外部資料,可以用錄製下來修改
19#的問題 要多看看VBA說明的 函數,方法,陳述式,屬性.來了解用法,可百尺竿頭,更近一步.
  1. Option Explicit
  2. 'Const 陳述式 宣告常數 , 其值如字面所示
  3. Sub a()
  4.     Dim x, ur As String
  5.     x = "2022"
  6.     Const url As String = "http://jsjustweb.jihsun.com.tw/z/zc/zcl/zcl_AAAA.asp.htm"
  7.     MsgBox url
  8.     ur = "http://jsjustweb.jihsun.com.tw/z/zc/zcl/zcl_" & x & ".asp.htm"
  9.     MsgBox ur
  10. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

norafang

帖子
26 
主題
7 
精華
0 
積分
27 
點名
0  
作業系統
WINDOWS 
軟體版本
OFFICE 2013 
閱讀權限
10 
性別
男 
註冊時間
2014-1-21 
最後登錄
2021-3-25 

論壇贊助勳章
22#
發表於 2014-1-22 17:48 | 只看該作者
回復 21# GBKEE
G大,謝謝您的耐心指教,依您的方式,我的寫法如下:
有以下幾個問題
1.為何我已指定代號在A1,但帶出表頭,而沒有資料?
擷取.JPG
2014-1-22 17:46

2.為何我指定放置位置於Range("AA1").Activate,跑完還是放在A2?
                                                       
Sub Test()
    Dim x, ur As String
    x = Worksheets("sheet1").Range("a1")
    Const url As String = "http://jsjustweb.jihsun.com.tw/z/zc/zcl/zcl_AAAA.asp.htm"
    MsgBox url
    ur = "http://jsjustweb.jihsun.com.tw/z/zc/zcl/zcl_" & x & ".asp.htm"
    MsgBox ur
    Cells.Clear
    Set ie = CreateObject("internetexplorer.application") '使用此方式可以免除 "設定引用項目"
    With ie
        .Visible = False 'True為開啟ie, False為不開啟ie
        .Navigate url
        Do While .ReadyState <> 4 '等待網頁開啟
            DoEvents
        Loop
        .ExecWB 17, 2 'Select All
        .ExecWB 12, 2 'Copy selection
        Sheets("Sheet1").Cells.Select
        Range("AA1").Activate
        ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
                False, NoHTMLFormatting:=True
    End With
    Columns("A:B").Delete
    ie.Quit
    MsgBox "資料複製結束"
End Sub

    煩請G大再幫我看看,謝謝

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
23#
發表於 2014-1-23 09:02 | 只看該作者
回復 22# norafang
VBA的經驗值太少了,需多修煉 21# 的程式碼是在說明 Const 陳述式
  1. Option Explicit
  2. Sub Test()
  3.     Dim x, ur As String, IE As Object
  4.     x = Worksheets("sheet1").Range("a1")
  5.   '  Const url As String = "http://jsjustweb.jihsun.com.tw/z/zc/zcl/zcl_AAAA.asp.htm"
  6.    ' MsgBox url
  7.     ur = "http://jsjustweb.jihsun.com.tw/z/zc/zcl/zcl_" & x & ".asp.htm"
  8.    ' MsgBox ur
  9.     Set IE = CreateObject("internetexplorer.application") '使用此方式可以免除 "設定引用項目"
  10.     With IE
  11.         .Visible = False 'True為開啟ie, False為不開啟ie
  12.         .Navigate ur
  13.         Do While .ReadyState <> 4 '等待網頁開啟
  14.             DoEvents
  15.         Loop
  16.         .ExecWB 17, 2 'Select All
  17.         .ExecWB 12, 2 'Copy selection
  18.         With Sheets("Sheet1")
  19.              .Cells.Clear
  20.             '.Cells.Select
  21.             .Range("AA1").Activate
  22.             .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
  23.                 False, NoHTMLFormatting:=True
  24.         End With
  25.     End With
  26.     Columns("A:B").Delete
  27.     IE.Quit
  28.     MsgBox "資料複製結束"
  29. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

norafang

帖子
26 
主題
7 
精華
0 
積分
27 
點名
0  
作業系統
WINDOWS 
軟體版本
OFFICE 2013 
閱讀權限
10 
性別
男 
註冊時間
2014-1-21 
最後登錄
2021-3-25 

論壇贊助勳章
24#
發表於 2014-1-23 09:36 | 只看該作者
回復 23# GBKEE
G大,感謝您,已經可以跑了,雖然內容有很多我還是不太了解,但您已經給了很大的方向了,感謝唷!

TOP

alantsai777

帖子
3 
主題
0 
精華
0 
積分
2 
點名
0  
作業系統
windows 
軟體版本
7.0 
閱讀權限
10 
註冊時間
2014-12-27 
最後登錄
2024-3-16 
25#
發表於 2014-12-27 15:21 | 只看該作者
請問如果網頁每10秒資料變動
如
http://mis.twse.com.tw/stock/fibest.jsp?stock=3673
隔 10 秒自動更新
[上市] 3673 F-TPK(元，交易單位)
最近
成交價        漲跌價差
(百分比)        當盤
成交量        累積
成交量        揭示
買價        揭示
買量        揭示
賣價        揭示
賣量        開盤        最高        最低        說明
200.00        ▲1.50(0.76%)        359        2118        199.50        11        200.00        58        199.50        200.50        198.00       
能否請幫忙告知如何抓 謝謝

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
26#
發表於 2014-12-28 09:23 | 只看該作者
回復 25# alantsai777
隔 10 秒自動更新 ?? 這網頁 間隔 5 秒自動更新!!
程式碼複製到一般模組
  1. Option Explicit
  2. Dim IE As Object
  3. Sub Ex_基本市況報導網站()
  4.     Dim A As Object, xDate As Date, EDATE As Date
  5.     Set IE = CreateObject("InternetExplorer.Application")
  6.     With IE
  7.        ' .Visible = True
  8.         .Navigate "http://mis.twse.com.tw/stock/fibest.jsp?stock=3673"
  9.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  10.     End With
  11.     Ex_副程式
  12. End Sub
  13. Private Sub Ex_副程式()
  14.     Dim A As Object, K As Integer, i As Integer, ii As Integer
  15.     With IE
  16.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  17.         Set A = .Document.getElementsByTagName("table")(1)
  18.     End With
  19.     With ActiveSheet    '可指定工作表
  20.         .UsedRange.Clear
  21.         K = 1
  22.         For i = 0 To A.Rows.Length - 1
  23.             For ii = 0 To A.Rows(i).Cells.Length - 1
  24.                 .Cells(K, ii + 1) = A.Rows(i).Cells(ii).INNERTEXT
  25.             Next
  26.             K = K + 1
  27.         Next
  28.     End With
  29.     If Time <= #1:30:00 PM# Then   '收盤時間 自行調整
  30.         Application.OnTime Time + #12:00:05 AM#, "Ex_副程式"  '間隔5秒
  31.     Else
  32.         IE.Quit
  33.     End If
  34. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

aaron1059

帖子
1 
主題
0 
精華
0 
積分
2 
點名
0  
作業系統
window 
軟體版本
7 
閱讀權限
10 
性別
女 
註冊時間
2015-9-12 
最後登錄
2015-12-26 
27#
發表於 2015-9-12 13:47 | 只看該作者
請教GBKEE超級版主:
以下網頁的VBA要如何寫
https://tw.futures.finance.yahoo.com/future/options.html?opmr=optionfull&opcm=WTXO&opym=201509
cotton

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
28#
發表於 2015-9-14 06:12 | 只看該作者
本帖最後由 GBKEE 於 2015-9-14 06:14 編輯

回復 28# aaron1059
試試看
幫你找出傳回期權資料的網址不一樣.
  1. Option Explicit
  2. Sub Ex() 'Yahoo!奇摩股市--期權
  3.     Dim ie As Object, k As Integer, S As Integer, jj As Integer, i As Integer, AA As Object
  4.     Set ie = CreateObject("InternetExplorer.Application")
  5.     ie.Navigate "https://tw.screener.finance.yahoo.net/future/aa03?opmr=optionfull&opcm=WTFO&opym=201510&random=0.01296169775357775"
  6.     ie.Visible = True
  7.     Do While ie.Busy Or ie.ReadyState <> 4: DoEvents: Loop
  8.     Set AA = ie.Document.getelementsbytagname("table")
  9.     With Sheets(1)
  10.         .Cells.Clear
  11.         k = k + 1
  12.         For S = 0 To AA.Length - 1                 '已找出網頁的table內容在 5-7 中
  13.             For i = 0 To AA(S).Rows.Length - 1                 '資料的列位
  14.                 For jj = 0 To AA(S).Rows(i).Cells.Length - 1   '資料的欄位
  15.                     .Cells(k, jj + 1) = AA(S).Rows(i).Cells(jj).INNERTEXT
  16.                 Next
  17.                 k = k + 1
  18.              Next
  19.           Next
  20.        End With
  21.      ie.Quit
  22. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

bioleon69
　暱稱: 小B

中學生Rank: 2

帖子
62 
主題
14 
精華
0 
積分
86 
點名
0  
作業系統
win10 
軟體版本
offffice2013 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2016-8-23 
最後登錄
2017-11-5 

論壇贊助勳章
29#
發表於 2017-4-30 22:19 | 只看該作者
本帖最後由 bioleon69 於 2017-4-30 22:24 編輯

GBK大 請教一下
從上面爬文練習,目前可以從EXCEL叫出瀏覽器
之後要怎麼讀取網頁內容,內容寫入EXCEL
A3開始寫入
這邊真的卡住了..
以下是目前程式碼的進度
  1. Option Explicit
  2. Dim ie As Object
  3. Sub 集保()
  4.     Dim keyin As String
  5.     keyin = Range("a1")
  6.     Set ie = CreateObject("InternetExplorer.Application")
  7.       With ie
  8.          .Navigate "http://norway.twsthr.info/StockHolders.aspx?stock=" & keyin & ""
  9.          .Visible = True
  10.          Do While ie.Busy Or ie.readyState <> 4: DoEvents: Loop
  11.      End With
  12. Ex_副程式
  13. End Sub

  15. Private Sub Ex_副程式()
  16.     Dim A As Object
  17.     With ie
  18.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  19.         Set A = .Document.getElementsByTagName("table")
  20.     End With
  21.     With ActiveSheet    '可指定工作表
  22.         .UsedRange.Clear






  29.     End With
  30.     ie.Quit
  31. End Sub
複製代碼
懇請GBK大幫忙指點12...
擷取.JPG
2017-4-30 22:19
擷取2.JPG
2017-4-30 22:19

TOP

bioleon69
　暱稱: 小B

中學生Rank: 2

帖子
62 
主題
14 
精華
0 
積分
86 
點名
0  
作業系統
win10 
軟體版本
offffice2013 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2016-8-23 
最後登錄
2017-11-5 

論壇贊助勳章
30#
發表於 2017-5-1 10:22 | 只看該作者
本帖最後由 bioleon69 於 2017-5-1 10:27 編輯

目前成功可執行了,也多虧版上許多資源
有幾個問題想請教




請問一下
1.為什麼我執行出來後會有空白的列?
是哪邊出了什麼狀況?

擷取.JPG
2017-5-1 10:24


2.可以把寫入excel的資料,定義成一個東西嗎
可以用with  end with來控制內容(只控制寫入的部分)
比方說字體大小,寬度高度,上色,刪除/清除,等等
不會牽動到周圍的資料

3.目前程式碼還可優化嗎?
因為想要再弄一個迴圈執行後讓它跑1500次
這程式碼會不會很吃系統資源?(怕電腦lag)

感謝
以下程式碼
  1. Option Explicit
  2. Dim ie As Object
  3. Sub 測試()
  4.   Set ie = CreateObject("InternetExplorer.Application")
  5.     With ie
  6.         .Navigate "http://norway.twsthr.info/StockHolders.aspx?stock=2330"
  7.         .Visible = True
  8.         Do While ie.Busy Or ie.readyState <> 4: DoEvents: Loop
  9.     End With
  10.     UsedRange.Clear
  11.     Ex_副程式
  12. End Sub

  14. Private Sub Ex_副程式()
  15. Dim A, i, ii
  16.     With ie
  17.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  18.         Set A = .Document.getElementsByTagName("table")(9)
  19.     End With
  20.     With ActiveSheet    '可指定工作表
  21.    
  22.         For i = 0 To A.Rows.Length - 296
  23.             For ii = 3 To A.Rows(i).Cells.Length - 1
  24.            .Cells(i + 1, ii - 2) = A.Rows(i).Cells(ii).innertext
  25.             Next
  26.             Next
  27.     With Cells
  28.             .EntireRow.AutoFit
  29.             .EntireColumn.AutoFit
  30.     End With
  31.     End With
  32.     ie.Quit
  33. End Sub
複製代碼
另外附上檔案
test.rar (16.05 KB)

TOP

        靜思自在 : 虛空有盡．我願無窮，發願容易行願難。
12345
返回列表 上一主題