[發問] 股票歷史價格表

Scott090

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

下載 (33.76 KB)

2017-10-13 15:40

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

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

謝謝

jackyq

回復 15# Scott090

多工 ...

Scott090

回復 14# jackyq


    請 jackyq 大明示，以便學習

謝謝

jackyq

IE , ActiveX.EXE 最大特點是什?  善用之

Scott090

回復 11# iamaraymond

我想是資料的完整性問題，不是起始日期是否與資料日期一致
在下列位址有討論，請參考  
  http://forum.twbts.com/thread-20288-1-1.html

GBKEE

回復 11# iamaraymond
這網頁可能也有流量管制
試試看

1. Option Explicit
   
2. Sub 股價()
   
3.     Dim stockno As String, mydate1 As String, mydate2 As String, myurl As String
   
4.     Dim Ar As Variant, i As Integer, xTime As Date
   
5.     Ar = Array("2005/1/1", "2006/1/1", "2007/1/1", "2008/1/1")
   
6.     [B3] = 2303
   
7.     stockno = [B3]
   
8.     [B5] = Date
   
9.     For i = 0 To UBound(Ar)
   
10.         [b4] = Ar(i)
    
11.         [A10].CurrentRegion.Clear
    
12.         mydate1 = Format([b4], "YYYY/MM/DD")
    
13.         mydate2 = Format([B5], "YYYY/MM/DD")
    
14.         myurl = "https://www.cnyes.com/twstock/ps_historyprice.aspx?code=" & stockno & "&ctl00$ContentPlaceHolder1$startText=" & mydate1 & "&ctl00$ContentPlaceHolder1$endText=" & mydate2
    
15.         With ActiveSheet.QueryTables.Add(Connection:= _
    
16.             "URL;" & myurl, Destination:=Range("$A$10"))
    
17.             .RefreshStyle = xlOverwriteCells
    
18.             .SaveData = True
    
19.             .AdjustColumnWidth = False
    
20.             .WebSelectionType = xlSpecifiedTables
    
21.             .WebFormatting = xlWebFormattingNone
    
22.             .WebTables = "1"
    
23.             Application.StatusBar = "資料下載中 ... " & [b4]
    
24.             .Refresh BackgroundQuery:=False
    
25.             .Delete
    
26.         End With
    
27.         With [A10].End(xlDown)
    
28.             .Select
    
29.             If Abs(.Cells - [b4]) > 15 Then
    
30.                 MsgBox "開始日期 " & [b4] & " <****> " & .Cells
    
31.             End If
    
32.         End With
    
33.         If i < UBound(Ar) Then
    
34.             xTime = Time
    
35.             Do
    
36.                 DoEvents
    
37.                 Application.StatusBar = xTime + #12:00:20 AM# & " - 等候 20秒 ..." & Time
    
38.             Loop While xTime + #12:00:20 AM# > Time
    
39.         Else
    
40.             MsgBox "程式 完畢 "
    
41.         End If
    
42.     Next
    
43. End Sub

複製代碼

iamaraymond

回復 8# GBKEE


   我記得會造成不一樣是因為如果輸入日期剛好碰到假日，那資料會以下一個工作日開始，例如輸入20180128(日)，那就會抓到從20180129(一)開始的資料

Scott090

回復 8# GBKEE

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

謝謝

Scott090

回復 8# GBKEE


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

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

再次感恩

GBKEE

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

複製代碼