12
返回列表 上一主題 發帖

[發問] 股票歷史價格表

Scott090

帖子
523 
主題
56 
精華
0 
積分
601 
點名
86  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2025-4-13 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2017-10-13 15:46 | 只看該作者

[發問] 股票歷史價格表

進入這個網站取得個股歷史價：
http://www.cnyes.com/twstock/ps_historyprice/2330.htm


它只有固定的日期區間資料

請教導 ：
              VBA 如何用 選用其中的"開始日期"及"結束日期"及 "查詢" 而取得更長區間的資料表

謝謝
收藏 分享

Scott090

帖子
523 
主題
56 
精華
0 
積分
601 
點名
86  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2025-4-13 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章
2#
發表於 2017-10-20 15:12 | 只看該作者
回復 1# Scott090

參考以下程式碼可以設定日期區間
繼續尋求更佳的方法
  1. '從鉅亨網取得歷史股價
  2. '使用 IE 物件
  3. 'option explicit
  4. 'option base 1

  6. Sub TestCNYES()

  8.     Dim Price(0 To 20, 0 To 9)
  9.     Dim Code
  10.     Code = "2330"
  11.    
  12.     Dim IE As Object, URL$
  13.     Dim date0 As Date, StartDate$, EndDate$, timer, time0 As Date
  14.     Dim Table As Object, oDoc As Object, E
  15.     Dim Re%, Ce%, i%, k%, ColName$
  16.    
  17.     ActiveSheet.Cells.Clear
  18.    
  19.     '設定資料開始及結束日期
  20.     StartDate = Format(DateAdd("m", -2, Date), "yyyy/mm/dd")   '取2個月的資料，約40筆
  21.     EndDate = Format(Date, "yyyy/mm/dd")
  22.    
  23.     k = 0
  24. Again:
  25.     Set IE = CreateObject("InternetExplorer.Application")
  26.     With IE
  27.             URL = "http://www.cnyes.com/twstock/ps_historyprice/" & Code & ".htm"
  28.             .Visible = False                '不顯示 IE
  29.             .navigate URL
  30.             
  31.             time0 = Now() + #12:00:05 AM#   '設定時間控制計時5秒鐘
  32.             Do
  33.                 DoEvents
  34.             Loop While (.Busy Or .readystate <> 4) And Time < time0
  35.            
  36.            '網頁未準備好，關閉重啟
  37.             If .readystate <> 4 Then
  38.                 .Quit
  39.                 k = k + 1
  40.                 If k <= 2 Then GoTo Again
  41.                 GoTo GiveUp                   '開啟3次都失敗就放棄
  42.             End If
  43.             
  44.             Set oDoc = .Document.getElementsByTagName("input")
  45.             With oDoc
  46.                  .Item("ctl00$ContentPlaceHolder1$startText").Value = StartDate ' 開始日期 input name
  47.                  .Item("ctl00$ContentPlaceHolder1$endText").Value = EndDate     ' 結束日期 input name
  48.             
  49.                  Set E = .Item("ctl00$ContentPlaceHolder1$submitBut")           '查詢鍵名稱
  50.                     E.Click                                                     '按查詢鍵
  51.             End With
  52.             
  53.             k = 0
  54.             time0 = Now() + #12:00:05 AM#   '設定時間控制計時5秒鐘
  55.             Do
  56.                 DoEvents
  57.             Loop While (.Busy Or .readystate <> 4) And Now() < time0
  58.             
  59.             Application.Wait Time + #12:00:03 AM#
  60.             
  61.             Set E = .Document.getElementsByTagName("TABLE")(1)
  62.             If E Is Nothing Then IE.Quit: GoTo Again
  63.             
  64.             For Re = 0 To 19          '取19天的歷史紀錄
  65.                 For Ce = 0 To 8
  66.                     Price(Re, Ce) = E.Rows(Re).Cells(Ce).innertext   '日期、開、高、低、收、漲跌  漲% 成交量  成交金額
  67.                 Next
  68.             Next
  69.             
  70.             ActiveSheet.Cells(1, "A").Resize(20, 9).Value = Price
  71. GiveUp:
  72.         
  73.         .Quit
  74.     End With

  76. End Sub
複製代碼

TOP

iamaraymond
　暱稱: Raymond Chien

中學生Rank: 2

帖子
109 
主題
12 
精華
0 
積分
177 
點名
0  
作業系統
win10 
軟體版本
office2013 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2017-11-19 
最後登錄
2023-7-5 
3#
發表於 2018-1-29 01:15 | 只看該作者
回復 2# Scott090

幫大大補充一下，
1.44~51行那邊應該可以用document.all(name)取代會比較簡單
2.可以透過修改
https://www.cnyes.com/twstock/ps_historyprice.aspx?code=2330&ctl00$ContentPlaceHolder1$startText=2001/10/05&ctl00$ContentPlaceHolder1$endText=2018/01/09
然後用外部匯入，會比較快，也比較簡單
個人小小想法，參考一下
Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

TOP

Scott090

帖子
523 
主題
56 
精華
0 
積分
601 
點名
86  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2025-4-13 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章
4#
發表於 2018-1-29 06:19 | 只看該作者
回復 3# iamaraymond


    謝謝，我將試試看。
另，請教 Excel 2013 及它的 VBA 說明的查詢 是：
1.連線透過網路，
還是
2. 離線，已具備崁入(Built in)說明，只要按 F1 就可以

TOP

Scott090

帖子
523 
主題
56 
精華
0 
積分
601 
點名
86  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2025-4-13 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章
5#
發表於 2018-1-29 18:05 | 只看該作者
回復 3# iamaraymond

依據大大的指導，修改如下，請看看是不是這樣子。
謝謝
  1. '從鉅亨網取得歷史股價
  2. '使用 IE 物件
  3. 'option explicit
  4. 'option base 1

  6. Sub TestCNYES1()

  8.     Dim Price()
  9.     Dim Code
  10.     Code = "2330"
  11.    
  12.     Dim IE As Object, URL$
  13.     Dim date0 As Date, StartDate$, EndDate$, submitBTN$, timer, time0 As Date
  14.     Dim Table As Object, oDoc As Object, E
  15.     Dim Re%, Ce%, i%, k%, ColName$
  16.    
  17.     ActiveSheet.Cells.Clear
  18.    
  19.     '設定資料開始及結束日期
  20.     StartDate = Format(DateAdd("m", -2, Date), "yyyy/mm/dd")    '取2個月的資料，約40筆
  21.     EndDate = Format(Date, "yyyy/mm/dd")
  22.    
  23.     StartDate = "&ctl00$ContentPlaceHolder1$startText=" & StartDate           '開始日期 input name
  24.     EndDate = "&ctl00$ContentPlaceHolder1$endText=" & EndDate                  ' 結束日期 input name
  25. '    submitBTN = "&ctl00$ContentPlaceHolder1$submitBut=查詢"
  26.    
  27.     k = 0
  28. Again:
  29.     Set IE = CreateObject("InternetExplorer.Application")
  30.    
  31.     With IE
  32.             URL = "https://www.cnyes.com/twstock/ps_historyprice.aspx?code=" & Code & StartDate & EndDate
  33.             .Visible = False                '不顯示 IE
  34.             .navigate URL
  35.             
  36.             time0 = Now() + #12:00:05 AM#   '設定時間控制計時5秒鐘
  37.             Do
  38.                 DoEvents
  39.             Loop While (.Busy Or .readystate <> 4) And Time < time0
  40.            
  41.            '計時時間到了網頁未準備好，關閉重啟
  42.             If .readystate <> 4 Then
  43.                 .Quit
  44.                 k = k + 1
  45.                 If k <= 2 Then GoTo Again
  46.                 GoTo GiveUp                   '開啟3次都失敗就放棄
  47.             End If
  48.                         
  49. '            Set E = .Document.getElementsByTagName("TABLE")(0)
  50.             Set E = .Document.all.tags("TABLE")(0)          '這個網頁的資料表有變動
  51.             If E Is Nothing Then IE.Quit: GoTo Again
  52.             
  53.             i = E.Rows.Length - 1: k = E.Rows(1).Cells.Length - 1
  54.             ReDim Price(0 To i, 0 To k)
  55.             
  56.             For Re = 0 To i         '取19天的歷史紀錄
  57.                 For Ce = 0 To k
  58.                     Price(Re, Ce) = E.Rows(Re).Cells(Ce).innertext   '日期、開、高、低、收、漲跌  漲% 成交量  成交金額
  59.                 Next
  60.             Next
  61.             
  62.             ActiveSheet.Cells(1, "A").Resize(i + 1, k + 1).Value = Price
  63. GiveUp:
  64.         
  65.         .Quit
  66.     End With

  68. End Sub
複製代碼

TOP

iamaraymond
　暱稱: Raymond Chien

中學生Rank: 2

帖子
109 
主題
12 
精華
0 
積分
177 
點名
0  
作業系統
win10 
軟體版本
office2013 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2017-11-19 
最後登錄
2023-7-5 
6#
發表於 2018-1-29 19:49 | 只看該作者
回復 5# Scott090


  我的是按F1之後會上網找說明

另外我的想法是用QueryTable的方式
  1. Sub 股價()

  3. [A10].CurrentRegion.Clear

  5. stockno = [B3]
  6. mydate1 = Format([B4], "YYYY/MM/DD")
  7. mydate2 = Format([B5], "YYYY/MM/DD")
  8. myurl = "https://www.cnyes.com/twstock/ps_historyprice.aspx?code=" & stockno & "&ctl00$ContentPlaceHolder1$startText=" & mydate1 & "&ctl00$ContentPlaceHolder1$endText=" & mydate2

  10. With ActiveSheet.QueryTables.Add(Connection:= _
  11.         "URL;" & myurl _
  12.         , Destination:=Range("$A$10"))
  13.         .RowNumbers = False
  14.         .FillAdjacentFormulas = False
  15.         .PreserveFormatting = False
  16.         .RefreshOnFileOpen = False
  17.         .BackgroundQuery = False
  18.         .RefreshStyle = xlOverwriteCells
  19.         .SavePassword = False
  20.         .SaveData = True
  21.         .AdjustColumnWidth = False
  22.         .RefreshPeriod = 0
  23.         .WebSelectionType = xlSpecifiedTables
  24.         .WebFormatting = xlWebFormattingNone
  25.         .WebTables = "1"
  26.         .WebPreFormattedTextToColumns = True
  27.         .WebConsecutiveDelimitersAsOne = True
  28.         .WebSingleBlockTextImport = False
  29.         .WebDisableDateRecognition = False
  30.         .WebDisableRedirections = False
  31.         .Refresh BackgroundQuery:=False
  32.         .Delete
  33.     End With
  34. End Sub
複製代碼
Excel VBA網頁資料收集教學:
http://forum.twbts.com/thread-20848-1-1.html

TOP

Scott090

帖子
523 
主題
56 
精華
0 
積分
601 
點名
86  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2025-4-13 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章
7#
發表於 2018-1-30 06:35 | 只看該作者
回復 6# iamaraymond


    " ..... F1上網找說明 ....  "，就因為需網路連結這麼不方便，放棄使用。

謝謝大大的 QueryTable 模式。
因有其他程式碼的連結使用所以我直接把資料放進陣列

TOP

GBKEE

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

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

回復 6# iamaraymond
這網頁用QueryTable 得取的資料有時起始日期會不準確,試試修改起始日期,看看資料是否正確

回復 7# Scott090
  1. Option Explicit
  2. Sub Ex_Ie_Copy()
  3.     Dim Code As String, Price()
  4.     Dim date0 As Date, StartDate$, EndDate$, timer, time0 As Date, IE_StartDate As String
  5.     Dim E As Object, IE As Object
  6.     Code = "2330"
  7.     time0 = Time
  8.     Application.StatusBar = "開啟網頁...."
  9.     '設定資料開始及結束日期
  10.     StartDate = Format(DateAdd("m", -12 * 10, Date), "yyyy/mm/dd") '取10年資料筆
  11.     If StartDate < CDate("1994/09/07") Then
  12.         MsgBox "StartDate  " & StartDate & vbLf & "不可小於" & "1994/09/07"
  13.         End
  14.     End If
  15.     EndDate = Format(Date, "yyyy/mm/dd")
  16. Set IE = CreateObject("InternetExplorer.Application")
  17.     With IE
  18.             .navigate "http://www.cnyes.com/twstock/ps_historyprice/" & Code & ".htm"
  19.             Do:          DoEvents:             Loop While .Busy Or .readystate <> 4

  21.             With .Document.getElementsByTagName("input")
  22.                  .Item("ctl00$ContentPlaceHolder1$startText").Value = StartDate ' 開始日期 input name
  23.                  .Item("ctl00$ContentPlaceHolder1$endText").Value = EndDate     ' 結束日期 input name
  24.                  .Item("ctl00$ContentPlaceHolder1$submitBut").Click
  25.             End With
  26.             Do:          DoEvents:             Loop While .Busy Or .readystate <> 4
  27.             On Error Resume Next
  28.             Do
  29.                 Err.Clear
  30.                 Set E = .Document.getElementsByTagName("TABLE")(0)
  31.                 If E.INNERTEXT <> "" Then
  32.                     If Err = 0 Then
  33.                         If Abs(DateValue(E.Rows(E.Rows.Length - 1).Cells(0).INNERTEXT) - DateValue(StartDate)) <= 15 Then
  34.                             If Err = 0 Then Exit Do
  35.                         End If
  36.                     End If
  37.                End If
  38.              DoEvents
  39.              Application.StatusBar = " 等候 網頁資料中 ... "
  40.             Loop
  41.             On Error GoTo 0
  42.             CopyToClipbox E.OUTERHTML
  43.             Application.StatusBar = StartDate & " - " & EndDate & " 資料共 " & E.Rows.Length - 1 & " 讀取.." & Application.Text(Time - time0, ["m分:S秒 ok"])
  44.             .Quit
  45.     End With
  46. End Sub
  47. Private Sub CopyToClipbox(strText As String)    '文本拷貝到剪貼板
  48.     With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
  49.         .SetText strText
  50.         .PutInClipboard
  51.     End With
  52.     With ActiveSheet
  53.         .UsedRange.Clear
  54.         .[A1].Select
  55.         .Paste
  56.     End With
  57. End Sub
複製代碼
  1. Sub Ex_Ie()
  2.     Dim Code As String, Price()
  3.     Dim StartDate$, EndDate$, time0 As Date
  4.     Dim E As Object
  5.     Dim Re%, Ce%
  6.     Code = "2330"
  7.     time0 = Time
  8.     ActiveSheet.Cells.Clear
  9.     Cells(1).Activate
  10.     Application.StatusBar = "開啟網頁...."
  11.     '設定資料開始及結束日期
  12.     StartDate = Format(DateAdd("m", -12 * 10, Date), "yyyy/mm/dd") '取10年資料筆
  13.     If StartDate < CDate("1994/09/07") Then
  14.         MsgBox "StartDate  " & StartDate & vbLf & "不可小於" & "1994/09/07"
  15.         End
  16.     End If
  17.     EndDate = Format(Date, "yyyy/mm/dd")
  18.    
  19.     With CreateObject("InternetExplorer.Application")
  20.             .navigate "http://www.cnyes.com/twstock/ps_historyprice/" & Code & ".htm"
  21.             Do:          DoEvents:             Loop While .Busy Or .readystate <> 4
  22.             With .Document.getElementsByTagName("input")
  23.                  .Item("ctl00$ContentPlaceHolder1$startText").Value = StartDate ' 開始日期 input name
  24.                  .Item("ctl00$ContentPlaceHolder1$endText").Value = EndDate     ' 結束日期 input name
  25.                  .Item("ctl00$ContentPlaceHolder1$submitBut").Click
  26.             End With
  27.             Do:          DoEvents:             Loop While .Busy Or .readystate <> 4
  28.             On Error Resume Next
  29.             Do
  30.                 Err.Clear
  31.                 Set E = .Document.getElementsByTagName("TABLE")(0)
  32.                 If E.INNERTEXT <> "" Then
  33.                     If Err = 0 Then
  34.                         If Abs(DateValue(E.Rows(E.Rows.Length - 1).Cells(0).INNERTEXT) - DateValue(StartDate)) <= 15 Then
  35.                             If Err = 0 Then Exit Do
  36.                         End If
  37.                     End If
  38.                 End If
  39.                 DoEvents
  40.                 Application.StatusBar = " 等候 網頁資料中 ... "
  41.             Loop
  42.             On Error GoTo 0
  43.             'ReDim Price(0 To E.Rows.Length - 1, 0 To E.Rows(0).Cells.Length - 1)
  44.             Application.StatusBar = StartDate & " - " & EndDate & " 資料共 " & E.Rows.Length - 2 & " 讀取...... "
  45.             For Re = 0 To E.Rows.Length - 1 ' 19          '取19天的歷史紀錄
  46.                 For Ce = 0 To E.Rows(Re).Cells.Length - 1
  47.                     Cells(Re + 1, Ce + 1) = E.Rows(Re).Cells(Ce).INNERTEXT '日期、開、高、低、收、漲跌  漲% 成交量  成交金額
  48.                    ' Price(Re, Ce) = E.Rows(Re).Cells(Ce).innertext   '日期、開、高、低、收、漲跌  漲% 成交量  成交金額
  49.                 Next
  50.             Next
  51.             'ActiveSheet.Cells(1, "A").Resize(UBound(Price), UBound(Price, 2)).Value = Price
  52.         Application.StatusBar = StartDate & " - " & EndDate & " 資料共 " & E.Rows.Length - 2 & " 讀取.." & Application.Text(Time - time0, ["m分:S秒 ok"])
  53.         .Quit
  54.     End With
  55. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

Scott090

帖子
523 
主題
56 
精華
0 
積分
601 
點名
86  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2025-4-13 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章
9#
發表於 2018-1-31 07:22 | 只看該作者
[版主管理留言]
  • GBKEE(2018/1/31 10:48): 某些檔股票讀不到資料的情形,可否列出哪些檔股票

回復 8# GBKEE


    謝謝 GBKEE 大大 提供的：
資料完整性的查檢機制、 Clip Board 的方法

另， Do
                 .......
                 Application.StatusBar = " 等候 網頁資料中 ... "
          Loop
中，有時不知甚麼狀況會有某些檔股票讀不到資料的情形，所以需要用時間計時來控制並放棄

再次感恩

TOP

Scott090

帖子
523 
主題
56 
精華
0 
積分
601 
點名
86  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2025-4-13 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章
10#
發表於 2018-1-31 21:49 | 只看該作者
回復 8# GBKEE

   沒有記錄下來，不過好像不是一個特定的；有時用手動直接去檢查又會在網頁上出現資料
下次碰到把它們記下來送給參考。
我在懷疑是網路本身的傳輸也說不定

謝謝

TOP

        靜思自在 : 人的心地是一畦田，土地沒有播下好種子，也長不出好的果實。 -
12
返回列表 上一主題