返回列表 上一主題 發帖

[發問] 股票歷史價格表

回復 6# iamaraymond


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

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

TOP

回復 5# Scott090


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

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

  2. [A10].CurrentRegion.Clear

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

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

TOP

回復 3# iamaraymond

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

  5. Sub TestCNYES1()

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

  65. End Sub
複製代碼

TOP

回復 3# iamaraymond


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

TOP

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

回復 1# Scott090

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

  5. Sub TestCNYES()

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

  73. End Sub
複製代碼

TOP

        靜思自在 : 成功是優點的發揮,失敗是缺點的累積。
返回列表 上一主題