麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 網頁資料下載簡化 [打印本頁]

作者: carzyindex 時間: 2011-4-29 17:11 標題: 網頁資料下載簡化

本帖最後由 carzyindex 於 2011-5-21 09:26 編輯

這個網站比較有人性一點參數找的到也可以設定

但是我不知道頁數有幾張

土法煉鋼一頁一頁弄也很沒有效率

查詢太多次還會被檔

請問程式該如何下載

例如1101

2201

作者: diabo 時間: 2011-4-30 16:38

54

用 page_num = document.getElementById("sp_ListCount").innerText

就知道頁數了...

不過查詢大多次會被擋，用VBA程式一樣會被擋.....

作者: GBKEE 時間: 2011-4-30 20:58

本帖最後由 GBKEE 於 2011-5-1 10:46 編輯

回復 1# carzyindex
PS: 今日(5/1)測試此網頁只允許連續下載10頁

Sub Ex()
Dim 股票代號 As String, 日期 As Variant, N, i As Integer
Do While Not IsDate(日期)
日期 = InputBox("輸入查詢日期", "日期", Date)
If 日期 = "" Then End
Loop
Do While 股票代號 = ""
股票代號 = InputBox("股票代號", "輸入查詢之股票代號", "1101")
If 日期 = "" Then End
Loop
日期 = Format(日期, "yyyymmdd")
With ActiveSheet
For Each N In .Names
N.Delete
Next
.Cells.Clear
Application.ScreenUpdating = False
With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=" & 日期 & "&StartNumber=" & 股票代號 & "&FocusIndex=1", Destination:=Range("A1"))
.Name = 日期 & "_" & 股票代號 & "_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
If Application.CountA(.ResultRange) = 0 Then
MsgBox Format(日期, "0000/00/00") & " 休市!!! 或股票代號:" & 股票代號 & " 錯誤 !!!"
[A1].Select
End
End If
End With
i = 2
Do
.Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=" & 日期 & "&StartNumber=" & 股票代號 & "&FocusIndex=" & i, Destination:=Selection)
.Name = 日期 & "_" & 股票代號 & "_" & i
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "6"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
If .ResultRange(1) Like "ip*" Then
.ResultRange.Clear
GoTo Out
End If
i = i + 1
End With
Loop
Out:
.UsedRange.Columns.AutoFit
.[A1].Select
End With
Application.ScreenUpdating = True
End Sub

複製代碼

作者: carzyindex 時間: 2011-5-3 08:13

本帖最後由 carzyindex 於 2011-5-3 08:20 編輯

回復 3# GBKEE

感謝各位大大的幫忙

請問可以批次10頁10頁的下載嗎

作者: GBKEE 時間: 2011-5-3 21:41

本帖最後由 GBKEE 於 2011-5-4 09:15 編輯

回復 4# carzyindex
請耐心等候程式在跑時 **請勿按下** [確定]

'此網頁有下載管制須有下載時間間隔 3秒可全部下載完成
A = CreateObject("WScript.Shell").popup("請等待4秒後下載" & Chr(10) & Chr(10) & "** 請勿按下 ** [確定]", 3, 日期 & "_" & .[F2] & " 第" & i & "頁", 16 * 3 + 0)

Sub 個股交易明細下載()
Dim 股票代號 As String, 日期 As Variant, N, i As Integer, A, T As Date
Do While Not IsDate(日期)
日期 = InputBox("輸入查詢日期", "日期", Date)
If 日期 = "" Then End
Loop
Do While 股票代號 = ""
股票代號 = InputBox("股票代號", "輸入查詢之股票代號", "1101")
If 日期 = "" Then End
Loop
日期 = Format(日期, "yyyymmdd")
T = Time
With ActiveSheet
For Each N In .Names
N.Delete
Next
.Cells.Clear
Application.StatusBar = False
On Error GoTo A_Wait
With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=" & 日期 & "&StartNumber=" & 股票代號 & "&FocusIndex=1", Destination:=Range("A1"))
.Name = 日期 & "_" & 股票代號 & "_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
If Application.CountA(.ResultRange) = 0 Then
MsgBox Format(日期, "0000/00/00") & " 休市!!! 或股票代號:" & 股票代號 & " 錯誤 !!!"
[A1].Select
End
End If
End With
i = 2
Do
.Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=" & 日期 & "&StartNumber=" & 股票代號 & "&FocusIndex=" & i, Destination:=Selection)
.Name = 日期 & "_" & 股票代號 & "_" & i
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "6"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
''''''無法查詢時稍待到 A_Wait: '''''
.Refresh BackgroundQuery:=False
If Application.CountA(.ResultRange) = 0 Then GoTo Out
i = i + 1
End With
A = CreateObject("WScript.Shell").popup("請等後下載..." & Chr(10) & Chr(10) & "** 請勿按下 ** [確定]", 4, 日期 & "_" & .[F2] & " 第" & i & "頁", 16 * 3 + 0)
Application.ScreenUpdating = True
Loop
Out:
.UsedRange.Columns.AutoFit
.[A1].Select
A = CreateObject("WScript.Shell").popup("共下載" & i & "頁", 5, 日期 & "_" & 股票代號, 48 + 0)
Application.StatusBar = "共下載 " & i & "頁費時 " & Format(Time - T, "HH:MM:SS")
End With
End
A_Wait:
Application.StatusBar = "無法查詢等候10秒鐘"
Application.Wait Now + TimeValue("00:00:10")
Err.Clear
Application.StatusBar = False
Resume '重返查詢
End Sub

複製代碼

作者: carzyindex 時間: 2011-5-4 08:06

回復 5# GBKEE

感謝版大再次相助,非常感謝.

作者: carzyindex 時間: 2011-5-4 08:22

回復 5# GBKEE

看來問題比我想像中還大的樣子

第一頁資料位置偏移

今天早上測試出現error 408

載到第六頁就掛掉了

無奈我只會排版的vba對網頁的不知道從何下手

作者: GBKEE 時間: 2011-5-4 09:14

本帖最後由 GBKEE 於 2011-5-4 19:57 編輯

回復 7# carzyindex
5樓的程式剛才測試是有些不順已稍為修改了
第一頁資料位置偏移

Sub 簡易明細下載()
Dim 股票代號 As String, 日期 As Variant, N, i As Integer, A, T As Date
Do While Not IsDate(日期)
日期 = InputBox("輸入查詢日期", "日期", Date)
If 日期 = "" Then End
Loop
Do While 股票代號 = ""
股票代號 = InputBox("股票代號", "輸入查詢之股票代號", "1101")
If 日期 = "" Then End
Loop
日期 = Format(日期, "yyyymmdd")
T = Time
With ActiveSheet
For Each N In .Names
N.Delete
Next
.Cells.Clear
Application.StatusBar = False
On Error GoTo A_Wait
i = 1
Do
.Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=" & 日期 & "&StartNumber=" & 股票代號 & "&FocusIndex=" & i, Destination:=Selection)
.Name = 日期 & "_" & 股票代號 & "_" & i
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "6"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
''''''無法查詢時稍待到 A_Wait: '''''
.Refresh BackgroundQuery:=False
If Application.CountA(.ResultRange) = 0 Then GoTo Out
i = i + 1
End With
A = CreateObject("WScript.Shell").popup("請等後下載..." & Chr(10) & Chr(10) & "** 請勿按下 [確定] **", 4, 日期 & "_" & 股票代號 & " 第" & i & "頁", 16 * 3 + 0)
Application.ScreenUpdating = True
Loop
Out:
.UsedRange.Columns.AutoFit
.[A1].Select
A = CreateObject("WScript.Shell").popup("共下載" & i & "頁", 5, 日期 & "_" & 股票代號, 48 + 0)
Application.StatusBar = 股票代號 &" 共下載 " & i & "頁費時 " & Format(Time - T, "HH:MM:SS")
End With
End
A_Wait:
Application.StatusBar = "無法查詢等候5秒鐘"
Application.Wait Now + TimeValue("00:00:05")
Err.Clear
Application.StatusBar = False
Resume '重返查詢
End Sub

複製代碼

作者: GBKEE 時間: 2011-5-6 16:44

回復 9# carzyindex
這是另一領域我功力不夠也找不出來阿!

作者: carzyindex 時間: 2011-5-7 10:54

回復 10# GBKEE

感謝版大回覆

作者: carzyindex 時間: 2011-5-16 16:16

本帖最後由 carzyindex 於 2011-5-16 16:32 編輯

回復 10# GBKEE

想再次詢問版大兩個問題

1. 附件test
我想要依照sheet2清單 A欄
執行程式
另存新檔檔名為B欄

2. 附件1101
程式有時候後會有錯誤
F欄位篩選為空格
可以刪除嗎

作者: GBKEE 時間: 2011-5-16 21:15

回復 12# carzyindex
下載一支股票要將近10分鐘 , 我沒測試完,請你慢慢測試 .

Option Explicit
Sub 明細下載()
Dim 股票代號 As Range, 日期 As Variant, i As Integer, A, T As Date
Dim Rng As Range
Do While Not IsDate(日期)
日期 = InputBox("輸入查詢日期", "日期", Date)
If 日期 = "" Then End
Loop
日期 = Format(日期, "yyyymmdd")
Set 股票代號 = Workbooks("TEST.XLSX").Sheets("sheet2").[A1]
Do While 股票代號.Value <> ""
T = Time
With Workbooks("TEST.XLSX").Sheets.Add(After:=Sheets(Sheets.Count))
.Name = 日期 & "-" & 股票代號 '設立在工作表名稱
Application.StatusBar = False
On Error GoTo A_Wait
i = 1
Do
Set Rng = .Cells(Rows.Count, 1).End(xlUp).Offset(1)
DoEvents
With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=" & 日期 & "&StartNumber=" & 股票代號 & "&FocusIndex=" & i, Destination:=Rng)
.Name = 日期 & "_" & 股票代號 & "_" & i
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "6"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
''''''無法查詢時稍待到 A_Wait: '''''
.Refresh BackgroundQuery:=False
If Application.CountA(.ResultRange) = 0 Then GoTo Out
i = i + 1
End With
A = CreateObject("WScript.Shell").popup("請等後下載..." & Chr(10) & Chr(10) & "** 請勿按下 [確定] **", 4, 日期 & "_" & 股票代號 & " 第" & i & "頁", 16 * 3 + 0)
Application.ScreenUpdating = True
Loop
Out:
.UsedRange.Columns.AutoFit
''''''''刪除 A,F欄的空格 ''''''''''''''''''''''''''''''''
.Range(.Cells(Rows.Count, "B").End(xlUp).Offset(1), .Cells(Rows.Count, "B")).Offset(, -1).Clear
.Range(.Cells(Rows.Count, "G").End(xlUp).Offset(1), .Cells(Rows.Count, "G")).Offset(, -1).Clear
'''''''''''''''''''''''''''''''''''''''
A = CreateObject("WScript.Shell").popup("共下載" & i & "頁", 5, 日期 & "_" & 股票代號, 48 + 0)
Application.StatusBar = 股票代號 & " 共下載 " & i & "頁費時 " & Format(Time - T, "HH:MM:SS")
End With
Set 股票代號 = 股票代號.Offset(1)
Loop
End
A_Wait:
Application.StatusBar = "無法查詢等候10秒鐘" '網頁繁忙時程式會有錯誤
Application.Wait Now + TimeValue("00:00:10") '可增加等候查詢的秒數
Err.Clear
Application.StatusBar = False
Resume '重返查詢
End Sub

複製代碼

作者: diabo 時間: 2011-5-16 22:57

改用這個網址可一次抓完.... 不必分頁

http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=20110516&StartNumber=2454&FocusIndex=All_40&flg_Print=0

作者: carzyindex 時間: 2011-5-17 08:21

本帖最後由 carzyindex 於 2011-5-17 08:28 編輯

回復 14# diabo

非常感謝您在次相助

不過在下載前需要知道總頁數

但是這方面的應用還不是很熟稔

還是需要兩位的幫忙

還有時間日期為首頁就不需要一直輸入了

http://bsr.twse.com.tw/bshtm/

右上角

作者: GBKEE 時間: 2011-5-17 16:04

回復 15# carzyindex
有此網頁好辦些,但下載還是很費時的,慢慢的測試吧!!

[attach]6236[/attach]

作者: diabo 時間: 2011-5-17 19:27

回復 diabo

非常感謝您在次相助

不過在下載前需要知道總頁數

但是這方面的應用還不是很熟稔

還是需要兩位的幫忙

還有時間日期為首頁就不需要一直輸入了

http://bsr.twse.com.tw/bshtm/

右上角 ...
carzyindex 發表於 2011-5-17 08:21

1. 蒐集資料只是籌碼分析的第一步，你應該是希望一次能下載指定日期區間及所有上市櫃公司的歷史資料。
2. 建立個股籌碼分析，至少要用 ACCESS(*.mdb) 方式來儲存，一個資料表就可以解決所有問題。不論享分析個股在某段期間的籌碼變化或是某家券商的下單量.....等等，都可以輕易解決。前提是熟悉 SQL 語法。
3. 如果你的目的是投資，建議花錢買系統比較快。如果你的目的是學程式，可能還要需要下很多功夫。
4. 另外頁數在建資料庫其實沒用。

作者: carzyindex 時間: 2011-5-18 08:35

回復 16# GBKEE

感謝兩位的幫忙

正在學習資料庫,

想請問檔案儲存方式

分頁這麼多也不是辦法

還是建立日期資料夾

各股分別建立檔案呢

對資料庫來說該怎麼管理檔案

該存成csv檔嗎

作者: carzyindex 時間: 2011-5-18 08:42

回復 17# diabo

如1 2點所說

我是藉由這樣的資料

學習資料庫

頁數的事情是我忘記翻到第一頁去看

的確不重要

網路上的資料庫多半是人員名單關聯學習看起來和excel差距不大

但是對於時間的範例就找不太到

像是每天的物料變化和籌碼變化天天都改變才能真在體現資料庫的偉大和強大

感謝兩位撥冗回覆

作者: diabo 時間: 2011-5-18 22:46

回復 diabo

如1 2點所說

我是藉由這樣的資料

學習資料庫

頁數的事情是我忘記翻到第一 ...
carzyindex 發表於 2011-5-18 08:42

最起碼要做到像這樣子，才能分析.....

[attach]6262[/attach]

作者: ginbow 時間: 2011-7-24 00:54

如果要做籌碼分析證交所因該有提供三大法人個股每天買賣超資料
http://www.twse.com.tw/ch/trading/fund/TWT43U/TWT43U.php
提供給你參考資料下載這部分真的很困難...因為他有些以脫離VBA
有些網頁不是那麼有善所以要會些html的語法
不過你也可以試著用 ctrl c + ctrl v 方式把整個網頁複製到excel 在去抓你要的

^^ 祝你好運囉

作者: yuch8663 時間: 2012-2-9 11:19

謝謝GBKEE所做的範例。

作者: lasum 時間: 2012-5-30 14:47

目前正在學股票資料下載…
感謝GBKEE大…提供的程式…
目前測試正常…共下載23頁…

作者: white5168 時間: 2012-5-31 00:09

本帖最後由 white5168 於 2012-5-31 00:23 編輯

最近在5/30,5/29,5/28抓資料真的越來越有難度了,搞不懂到底哪個害群之馬一直在操掛證交所的伺服器,搞的大家要抓資料都變的很困難
我是用python來下載資料就已經快抓狂了,我看用VBA抓資料的人應該會更想打人,因為證交所的防火牆已經做了修改,因為在尖峰時段防火牆會限制連線數與時間,要長時間連線抓資料真的會有難度
用python下載上市795支股票的資訊,在這3天要花2~3小時,是平實抓上市795 上櫃615 (我抓的不是單一支股票的時間是全部)時間的3倍,真的大家找找這個害群之馬
最近也在用VBA抓網頁,但不是抓每日成交明細,不然我也會受不了
祝大家好運

作者: gracyei 時間: 2012-7-2 23:12

回復 carzyindex
有此網頁好辦些,但下載還是很費時的,慢慢的測試吧!!
GBKEE 發表於 2011-5-17 16:04

GBKEE大大,下載測試檔測試時第一支個股下載完畢後,會出現 "執行階段錯誤'424':此處需要物件" ,偵錯後會指向這一段程式" Sheets(日期 & "-" & 股票代號).Cells.Clear ",小弟還是初學者,想請問大大這一段代表什麼意思??請大大賜教

作者: GBKEE 時間: 2012-7-3 13:46

回復 27# gracyei
Sheets(日期 & "-" & 股票代號).Cells.Clear

"執行階段錯誤'424':此處需要物件 活頁簿中沒有命名為日期 & "-" & 股票代號 的工作表

日期 & "-" & 股票代號 這工作表所有Cells(儲存格).Clear(清除資料)

作者: gracyei 時間: 2012-7-4 00:02

回復 28# GBKEE

感謝GBKEE大大的回覆,小弟下載#16的測試檔做測試每次跑到第2檔1102時就會發生錯誤,且第2檔股票Sheet的內容會被這一段指令Clear掉,且代號的Sheet會被刪除掉;若只設定1檔則可完成,小弟還是找不出哪裡的問題,請問大大是哪裡的問題?? THX!!

作者: GBKEE 時間: 2012-7-4 16:13

回復 29# gracyei
將檔案上傳看看

作者: gracyei 時間: 2012-7-4 17:48

回復 gracyei
將檔案上傳看看
GBKEE 發表於 2012-7-4 16:13

測試檔是從本帖16樓下載,無做修改,麻煩GBKEE大大看一下
[attach]11576[/attach]

作者: GBKEE 時間: 2012-7-5 15:47

回復 31# gracyei
修改如下

Option Explicit
Sub 個股交易整頁()
Dim 股票代號 As Range, 日期 As Variant, F As Range
Do While Not IsDate(日期)
日期 = InputBox("輸入查詢日期", "日期", Date)
If 日期 = "" Then End
Loop
日期 = Format(日期, "yyyymmdd")
Set 股票代號 = ThisWorkbook.Sheets("代號").[A1]
On Error Resume Next '不理會在執行程式的時候發生的錯誤
Do While 股票代號.Value <> ""
ThisWorkbook.Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = 日期 & "-" & 股票代號
Sheets("代號").Activate
With Sheets(日期 & "-" & 股票代號)
With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=" & 日期 & "&StartNumber=" & 股票代號 & "&FocusIndex=All_100", Destination:=.Cells(1))
.Name = 日期 & "-" & 股票代號
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
Do
DoEvents
Err.Clear 'Err物件的重設
.Refresh BackgroundQuery:=False '查詢失敗會產生錯誤
Loop Until Err.Number = 0 '執行迴圈直到錯誤消:失查詢成功
End With
.Range("F5:H" & Rows.Count).Delete 1
.Range(.Cells(.Rows.Count, "B").End(xlUp).Offset(1), .Cells(.Rows.Count, "B")).Offset(, -1).Clear
.Range(.Cells(Rows.Count, "G").End(xlUp).Offset(1), .Cells(Rows.Count, "G")).Offset(, -1).Clear
Set F = .[A:A].Find("*頁 / 共*", LOOKAT:=xlPart)
Do While Not F Is Nothing
F.Offset(-1).Resize(7).EntireRow.Delete
Set F = .[A:A].FindNext
Loop
.UsedRange.Columns.AutoFit
End With
Set 股票代號 = 股票代號.Offset(1)
Loop
MsgBox "下載完畢 !!!", 32 + 0, "個股交易明細"
End Sub

複製代碼

作者: sd-jason 時間: 2012-7-6 17:02

各位大大：
請問像這些語法，
我應該把他貼在哪裡，
才能執行？
你們的檔案我都沒有辦法看，
是否可以寄給我呢？
[email protected]
感謝！

作者: GBKEE 時間: 2012-7-6 17:46

回復 33# sd-jason

[attach]11606[/attach]

作者: GBKEE 時間: 2012-7-6 18:14

回復 35# sd-jason
自己動動手才會進步 1.程式碼複製在到模組上(這程式碼適用工作表或一般模組)
2 .如 34# 製作一個工作表按鈕巨集指定為這程序
試試看

作者: gracyei 時間: 2012-7-6 21:51

回復 gracyei
修改如下
GBKEE 發表於 2012-7-5 15:47

感謝GBKEE大大的幫忙,可以順利下載了!!

作者: gracyei 時間: 2012-7-11 00:12

回復 gracyei
修改如下
GBKEE 發表於 2012-7-5 15:47

GBKEE大大
想請教一下,若下載完的Sheet名稱只要代號就好,不需要日期的話是不是修改32#的程式碼
13列: ActiveSheet.Name = 日期 & "-" & 股票代號 => ActiveSheet.Name = 股票代號
15列:With Sheets(日期 & "-" & 股票代號) => With Sheets(股票代號)
17列:.Name = 日期 & "-" & 股票代號 => .Name =股票代號
就可以了呢??感謝教導!!

作者: HSIEN6001 時間: 2012-7-11 00:32

回復 37# gracyei

沒錯啦!
可是......這個自己RUN就有答案
若怕不小心改錯,可先另外複製-份原稿

多RUN幾次,就會有點心得
加油!

作者: gracyei 時間: 2012-7-11 19:55

回復 gracyei

沒錯啦!
可是......這個自己RUN就有答案
若怕不小心改錯,可先另外複製-份原稿

多RU ...
HSIEN6001 發表於 2012-7-11 00:32

已有自己做過測試,但會變成無法下載,所以才發問,小弟還是初學者很多指令還不是很了解,請各位大大教導,謝謝!!

作者: HSIEN6001 時間: 2012-7-11 23:26

回復 39# gracyei

剛剛試,真的不行耶!
~是偶多話~金拍謝 =__=!!

你還是請G大排解好了
偶搞不清楚哪裡出問題

作者: mannyhsu 時間: 2012-7-21 10:53

已有自己做過測試,但會變成無法下載,所以才發問,小弟還是初學者很多指令還不是很了解,請各位大大教導,謝 ...
gracyei 發表於 2012-7-11 19:55

剛試了一下, 前面加一串文字就可以了 ~~

作者: mannyhsu 時間: 2012-7-23 19:43

改用這個網址可一次抓完.... 不必分頁
diabo 發表於 2011-5-16 22:57

請教一下, 上面這種 link 的方式, 好像不能用了,
有人知道有新的方式可用嗎 ?? 謝謝 !

作者: tsuneng 時間: 2012-7-25 19:48

感謝GBKEE大大 ,試了一下可用。

作者: sd-jason 時間: 2012-7-25 20:32

請問這個是不是已經無法下載了???這幾天下載都只跑出活頁代號，而沒有內容資料???

作者: white5168 時間: 2012-7-25 23:13

這幾天不式不能抓,而是網站被動了一些手腳,那大家抓的很辛苦也很痛苦,改用python抓會比較好一點

作者: mannyhsu 時間: 2012-7-26 00:50

我試了一下, 新的 link 變成 :
http://bsr.twse.com.tw/bshtm/bsContent.aspx?StartNumber=2498&FocusIndex=All_59
但是原本可用 All_100 抓到所有的 pages, 現在已經不能用了, 必須要知道確切的 page number,
請問一下, 那原始的程式該如何修改 ?
謝謝 !!

作者: lalalada 時間: 2012-7-26 10:48

本帖最後由 lalalada 於 2012-7-26 10:51 編輯

同樓上
以為終於建好自動更新資料的程式說QQ
原始碼裡有個 59
不知道能否用來取得頁數
也發現有
// window.open("bshtm/"+ HiddenField_spDate +"/"+ document.getElementById("hidTASKNO").value+"/"+ document.getElementById("hidTASKNO").value+".csv");
window.open("bsContent.aspx?StartNumber=" + document.getElementById("hidTASKNO").value + "&download=csv");
有機會下載CSV檔?
而且樓上說的那個網址才改沒幾天而已又在ALL上設新限制
看來是存心不想讓人抓了
話說之前寫信去問說八月開始要提供付費CSV
貌似是網頁改版主因...

作者: GBKEE 時間: 2012-7-26 17:23

回復 46# mannyhsu
回復 47# lalalada

Option Explicit
Sub Ex()
Dim Stock_No As String, wb As Workbook
Do
Stock_No = InputBox("請輸入股票號碼")
If Stock_No = "" Then If MsgBox("取消輸入股票號碼?", vbYesNo) = vbYes Then Exit Sub
Loop Until Stock_No <> ""
For Each wb In Workbooks
If wb.Name = "bsContent.aspx" Then wb.Close False
Next
On Error Resume Next
Application.DisplayAlerts = False
Workbooks.Open ("http://bsr.twse.com.tw/bshtm/bsContent.aspx?StartNumber=" & Stock_No & "&download=csv")
If Err.Number <> 0 Then MsgBox "1 請查明股票號碼 " & Stock_No & "是否存在" & Chr(10) & _
"2 股票號碼 " & Stock_No & " 如正確請重新輸入 " & Stock_No
Application.DisplayAlerts = True
End Sub

複製代碼

作者: mannyhsu 時間: 2012-7-26 20:21

回復 48# GBKEE

太感恩了, 這個可以用 ~~

作者: mannyhsu 時間: 2012-7-26 20:50

本帖最後由 mannyhsu 於 2012-7-26 20:56 編輯

回復 48# GBKEE

請問 GBKEE 大,
是否可以在目前的試算表中一個工作表(例如 temp)存放 csv 資料,
而不是另開一個試算表, 謝謝 !!

另外, 可能是原始的 CSV 資料有問題,
除了內容格式不對, 有些欄位內也沒有資料 ...

作者: GBKEE 時間: 2012-8-1 13:41

另外, 可能是原始的 CSV 資料有問題,
除了內容格式不對, 有些欄位內也沒有資料 ...mannyhsu 發表於 2012/7/26 20:50

這裡有正確的 http://forum.twbts.com/redirect.php?goto=findpost&pid=41636&ptid=7309

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