返回列表 上一主題 發帖

[發問] 股票歷史價格表

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2018-2-1 20:37 | 顯示全部帖子
本帖最後由 GBKEE 於 2018-2-1 20:39 編輯

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 站在半路，比走到目標更辛苦。
返回列表 上一主題