帖子: 15
主題: 4
精華: 0
積分: 27
點名: 0
作業系統: Windows
軟體版本: Win7
閱讀權限: 10
性別: 男
註冊時間: 2015-9-12
最後登錄: 2016-2-15

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2015-9-12 22:41 | 只看該作者

[發問] 集保戶股權分散表查詢抓每週資料

各位高手你們好小弟在爬完很多頁面
也google 看了幾個高手的語法，想要嘗試用 VBA 去集保戶股權分散表查詢，輸入一個代號，抓每週的股票股權分散表資料table，抓到Excel去分析
網址：http://www.tdcc.com.tw/smWeb/QryStock.jsp

但只會寫到怎麼把股票代號輸入，但是日期的選單實在不知要怎麼操作，網頁 "資料日期" select 找不到 .value，就停在這邊想好幾天，還是不知怎麼寫下去了
還請高手指教語法
感恩

==========================================
Sub 集保抓取()

Dim A
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop

With .document
'-----輸入要查詢的股票代碼
For Each A In .getelementsbytagname("INPUT") '找原始碼有input參數
If A.Name = "StockNo" Then A.Value = Range("B1").Value '找原始碼有input參數
Next

End With

End With
End Sub
==========================================

樓主熱帖

iamaraymond

　暱稱: Raymond Chien

中學生 Rank: 2

帖子: 109
主題: 12
精華: 0
積分: 177
點名: 0
作業系統: win10
軟體版本: office2013
閱讀權限: 20
性別: 男
來自: 高雄
註冊時間: 2017-11-19
最後登錄: 2023-7-5

27^#

發表於 2018-3-27 11:29 | 只看該作者

回復 26# oligo

哈囉，我剛剛上傳了一個新檔案，用來抓取改版後的資料，請參考
http://forum.twbts.com/thread-20646-1-1.html
希望有幫到您~

Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

TOP

oligo

中學生 Rank: 2

帖子: 9
主題: 2
精華: 0
積分: 51
點名: 0
作業系統: Win 7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
註冊時間: 2017-9-30
最後登錄: 2019-3-31

26^#

發表於 2018-3-25 12:33 | 只看該作者

回復 9# GBKEE
GBKEE 大大的 Web 版很好用，我常常利用這個程式查詢，但前幾天該相關網頁似乎有修改過，現在如果跑程式會出現如下的錯誤：
執行階段錯誤 '9':
陣列索引超出範圍

偵錯的話會停在第9行的
ReDim Ar(a.Length - 1)

不知如何因應這個新修的網頁去修改程式？
謝謝！

TOP

chang0833

中學生 Rank: 2

帖子: 23
主題: 1
精華: 0
積分: 58
點名: 0
作業系統: windows
軟體版本: Office 2016
閱讀權限: 20
性別: 男
註冊時間: 2014-2-26
最後登錄: 2018-8-23

25^#

發表於 2017-7-29 13:35 | 只看該作者

版大還是謝謝你，我後來用手動的把格線消除了
想說可不可以由電腦跑程式，順便學習一下，感恩^^

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

24^#

發表於 2017-7-29 12:54 | 只看該作者

回復 23# chang0833

我將工作表格線改成紅色,沒有下載到網頁格式顏色
你沒上傳檔案,我莫宰羊ㄚ

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

chang0833

中學生 Rank: 2

帖子: 23
主題: 1
精華: 0
積分: 58
點名: 0
作業系統: windows
軟體版本: Office 2016
閱讀權限: 20
性別: 男
註冊時間: 2014-2-26
最後登錄: 2018-8-23

23^#

發表於 2017-7-29 11:05 | 只看該作者

Sub Ex1()
Cells.Clear
Dim Ar(), a As Variant, i As Integer, stkno As String, Qur As String, DateVar As Integer, Sh As Worksheet
With CreateObject("InternetExplorer.Application")
.Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
Set a = .Document.ALL.tags("option") '資料日期的內容
ReDim Ar(a.Length - 1)
For i = 0 To a.Length - 1
Ar(i) = a(i).innerHTML
Next
.Quit
End With
stkno = Sheets("目標股票").Range("B2").Value '
If stkno = "" Then Exit Sub
Set Sh = ActiveSheet '指定工作表
With Sh
For DateVar = 0 To UBound(Ar)
Qur = "http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE=" & Ar(DateVar) & "&SqlMethod=StockNo&StockNo=" & stkno & "&StockName=&sub=%ACd%B8%DF"
.QueryTables.Add "URL;" & Qur, .Cells(1 + (DateVar * 32), "A")
'.Cells(1 + (DateVar * 32), "A") A欄間隔 32列
With .QueryTables(1)
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "6,7,8"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.PreserveFormatting = False
.Refresh BackgroundQuery:=False
Sh.Names(.Name).Delete '刪掉工作表上的名稱
.Delete '刪掉這QueryTable
End With
Next
End With