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

標題: 股價代號和起始日期的抓取 [打印本頁]

作者: gelai01000001 時間: 2013-9-23 23:15 標題: 指定下載3年歷史股價的資料

麻煩請各位高手專家及版主指導解惑：
下面網址中可指定查詢歷史資料的區間選項(預設值為20天)，有先在網站中更改查詢區間為3年。
但每次下載匯入EXCEL的資料只有21天，不知需要加入什麼程式碼才可解決？？
www.cnyes.com/twstock/ps_historyprice/6282.htm

Sub Macro1()
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.cnyes.com/twstock/ps_historyprice/6282.htm", Destination:= _
Range("A1"))
.RefreshStyle = xlOverwriteCells
.WebTables = "2"
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=-21
End Sub

複製代碼

因為YAHOO、GOOGLE的歷史資料有時無法顯示例外(開休市)的數據，造成計算MA值的數據不準確。
感謝各位高手專家撥空解惑。

作者: GBKEE 時間: 2013-9-24 15:04

回復 1# gelai01000001
下載3年歷史股價的資料

Option Explicit
Sub 鉅亨網_歷史行情()
Dim Sh As Worksheet, Code As String, d_Start As String, d_End As String
Dim A As Object, i As Integer, c As Integer, T As Date
Code = InputBox("輸入股票代號 : ", "股票代號", 2303)
d_End = InputBox("輸入結束日期 : ", "結束日期", Date)
If Len(Code) <= 3 Or Not IsDate(d_End) Then Exit Sub
Set Sh = ActiveSheet
With Sh
.UsedRange.Clear
.[a1] = Code
.[b1] = DateAdd("yyyy", -3, d_End) '下載3年歷史股價的資料
.[C1] = d_End
Code = .[a1]
d_Start = Format(.[b1], "yyyy/mm/dd")
d_End = Format(.[C1], "yyyy/mm/dd")
End With
With CreateObject("InternetExplorer.application")
.Navigate "http://www.cnyes.com/twstock/ps_historyprice/" & Code & ".htm"
'.Visible = True
Application.StatusBar = Code & " 歷史行情等候中..."
Do While .Busy Or .ReadyState <> 4
DoEvents
Loop
Set A = .Document.getelementsbytagname("input")
A(5).Value = d_Start
A(6).Value = d_End
A(7).Click
T = Time
Do
DoEvents
Loop Until Time > T + #12:00:08 AM#
Set A = .Document.getelementsbytagname("table")(1)
Application.StatusBar = Code & " 歷史行情下載中..."
Cells(2, 1) = .Document.getelementsbytagname("span")(79).innertext
For i = 0 To A.Rows.Length - 1
For c = 0 To A.Rows(i).Cells.Length - 1
Sh.Cells(i + 3, c + 1) = A.Rows(i).Cells(c).innertext
Next
Next
.Quit
End With
Application.StatusBar = Code & " 歷史行情 " & Application.Text(Time - T, "[S] 秒") & " 下載完成"
MsgBox "OK"
Application.StatusBar = False
End Sub

複製代碼

作者: gelai01000001 時間: 2013-9-24 22:52

回復 2# GBKEE

感謝GBKEE版主的熱心用心的解惑。
因位本人不材，不甚了解下列程式碼的語法及執行用意。
還煩請GBKEE版主抽空可說明註解惑指導一下嗎？

With CreateObject("InternetExplorer.application")
.Navigate "http://www.cnyes.com/twstock/ps_historyprice/" & Code & ".htm"
'.Visible = True
Application.StatusBar = Code & " 歷史行情等候中..."
Do While .Busy Or .ReadyState <> 4
DoEvents
Loop
Set A = .Document.getelementsbytagname("input")
A(5).Value = d_Start
A(6).Value = d_End
A(7).Click
T = Time
Do
DoEvents
Loop Until Time > T + #12:00:08 AM#
Set A = .Document.getelementsbytagname("table")(1)
Application.StatusBar = Code & " 歷史行情下載中..."
Cells(2, 1) = .Document.getelementsbytagname("span")(79).innertext

複製代碼

GBKEE版主：執行程式過程中，發現下載至EXCEL中的資料是有由〈Sh.Cells(i + 3, c + 1) = A.Rows(i).Cells(c).innertext〉而來，
不同於下載網頁資料〈WebTables = "number"〉，所用的指令方法。
我有上網收搜尋相關資料，大約清楚知道，上列程式碼式是在VBA程式中啟動網頁的(javascript)指令。
不知是與不是或一知半解！感謝GBKEE的指導。

作者: GBKEE 時間: 2013-9-25 07:53

回復 3# gelai01000001
CreateObject("InternetExplorer.application") 多搜尋一下會多了解的

With CreateObject("InternetExplorer.application")
'歷史行情預設為一個月資料,日期的更改需在網頁上更改
.Navigate "http://www.cnyes.com/twstock/ps_historyprice/" & Code & ".htm" 'IE的網址
'.Visible = True
Application.StatusBar = Code & " 歷史行情等候中..."
Do While .Busy Or .ReadyState <> 4 '等候網頁資料下載完成...
DoEvents
Loop
Set A = .Document.getelementsbytagname("input") '網頁中成員 tagname為 "input"
A(5).Value = d_Start '0 開始算起第6個 => 5 開始日期
A(6).Value = d_End '0 開始算起第7個 => 6 結束日期
A(7).Click '0 開始算起第8個 => 7 按下查詢鍵
T = Time
Do
DoEvents
Loop Until Time > T + #12:00:08 AM# '按下查詢鍵後,需等候網頁資料下載完成
Set A = .Document.getelementsbytagname("table")(1) ''0 開始算起第2個 => 1
'網頁中成員 tagname為 "table" ,為資料所在的位置.
Application.StatusBar = Code & " 歷史行情下載中..."
Cells(2, 1) = .Document.getelementsbytagname("span")(79).innertext 'innertext: 文字

複製代碼

作者: edwardlay 時間: 2013-9-27 17:02

請問大大下載時間可以擴大到多長?:)

作者: GBKEE 時間: 2013-9-27 17:18

回復 5# edwardlay
2# 看要幾年可修改 -3 看看

12. .[b1] = DateAdd("yyyy", -3, d_End) '下載3年歷史股價的資料

複製代碼

作者: gelai01000001 時間: 2013-10-12 00:21 標題: 如何將下載的股市每日盤後行情(製作成各股的歷史股價資料)

煩請各位高手專家解惑，謝謝!
請問有辦法將下列程碼的加以修改，把每日各股的盤後行情所得的資料轉換成(各股的歷史資料)。

Sub 下載網站資料()
Dim Startmonth As String, Startday As String, xDate As Date, Msg As Boolean, Sh As Worksheet
On Error GoTo EX '程式執行中有錯誤時跳到 EX: 繼續執行程式
xDate = Date '當日
Set Sh = ActiveSheet '指定工作表:此程式在任何模組中皆可用
EX:
If Err.Number <> 0 Or Msg = True Then '當日(尚未有資料:錯誤) 或休市
[color=Red]xDate = xDate - 1 (應改為xDate = Date - 1)[/color] 假如休市超過1天以上(2,3,4,5,6,春節9天)，又如何修改呢?
Err.Clear
Msg = False
End If
Sh.UsedRange.Clear '清理工作表已使用的範圍
Startday = Format(xDate, "YYYYMMDD")
Startmonth = Format(xDate, "YYYYMM")
'下載網站的網址
With Sh.QueryTables.Add(Connection:="URL;http://www.twse.com.tw/ch/trading/exchange/MI_INDEX/genpage/Report" & Startmonth & "/A112" & Startday & "ALLBUT0999_1.php?select2=ALLBUT0999&chk_date=" & Format(xDate, "E/MM/DD"), Destination:=Range("A3"))
.RefreshStyle = xlOverwriteCells '抓取網頁的第10個表格作為匯入資料
.WebTables = "10"
.Refresh BackgroundQuery:=False '當日(尚未有資料:錯誤)
If Application.CountA(Sh.QueryTables(1).ResultRange) = 0 Then '休市沒有資料
Msg = True
GoTo EX
End If
End With
With Sh.UsedRange
.Font.Size = 12
.EntireColumn.AutoFit
End With
End Sub

複製代碼

因為我已有下載各股歷史股價的資料程式和資料，且依代碼分類成多個活頁簿例如：
workbook(1.xls)有worksheet(1102)、worksheet(1103).....等。1活頁簿中有代碼，第一個數字有[1]的多個工作表。
workbook(2.xls)有worksheet(2102)、worksheet(2103).....等。2活頁簿中有代碼，第一個數字有[2]的多個工作表。
......
......
workbook(9.xls)有worksheet(9102)、worksheet(9103).....等。9活頁簿中有代碼，第一個數字有[9]的多個工作表。
所以想請問有沒有更簡便快速的方法。謝謝各位專家前輩的抽空指導。

作者: GBKEE 時間: 2013-10-12 15:43

回復 7# gelai01000001
試試看

Option Explicit
Sub 下載網站資料()
Dim Startmonth As String, Startday As String, xDate As Date, Msg As Boolean, Sh As Worksheet
Dim Wb As Workbook, Ws As Worksheet, Stock As Range
On Error GoTo EX '程式執行中有錯誤時跳到 EX: 繼續執行程式
xDate = Date '當日
Set Sh = Workbooks.Add.Sheets(1) '新活頁簿的第一個工作表
EX:
If Err.Number <> 0 Or Msg = True Then '當日(尚未有資料:錯誤) 或休市
xDate = xDate - 1 '往後退一天一直到開市. ( 假如休市超過1天以上(2,3,4,5,6,春節9天)
Err.Clear
Msg = False
End If
Startday = Format(xDate, "YYYYMMDD")
Startmonth = Format(xDate, "YYYYMM")
'下載網站的網址
With Sh.QueryTables.Add(Connection:="URL;http://www.twse.com.tw/ch/trading/exchange/MI_INDEX/genpage/Report" & Startmonth & "/A112" & Startday & "ALLBUT0999_1.php?select2=ALLBUT0999&chk_date=" & Format(xDate, "E/MM/DD"), Destination:=Range("A3"))
.RefreshStyle = xlOverwriteCells '抓取網頁的第10個表格作為匯入資料
.WebTables = "10"
.Refresh BackgroundQuery:=False '當日(尚未有資料:錯誤)
If Application.CountA(Sh.QueryTables(1).ResultRange) = 0 Then '休市沒有資料
Msg = True
GoTo EX
End If
End With
For Each Wb In Workbooks
For Each Ws In Wb.Sheets
Set Stock = Sh.[A:A].Find(Ws.Name, lookat:=xlWhole)
If Not Stock Is Nothing Then
Stock.Offset(, 2).Resize(, 14).Copy
With Ws
With .Range("a" & .Rows.Count).End(xlUp).Offset(1)
.Cells = xDate
.Offset(, 1).PasteSpecial xlPasteValuesAndNumberFormats
End With
End With
End If
Next
Next
Sh.Parent.Close False '關閉: 新活頁簿的第一個工作表
End Sub

複製代碼

作者: BigDog 時間: 2013-10-15 16:45 標題: 如何使用.iqy抓此網址資料

請問大家,

小弟在此網址 http://www.cnyes.com/twstock/directorholder/1101.htm ,想抓董監持股餘額資料,
但每個月的資料是用下拉式選單選取,網址都不會變動,請問應該如何才能利用.iqy更改參數抓資料...

謝謝各位
BigDog

作者: yuhuahsiao 時間: 2013-10-16 11:13

回復 1# BigDog

這個應該無法用iqy 抓取
要用VBA

作者: GBKEE 時間: 2013-10-16 16:23

本帖最後由 GBKEE 於 2016-4-26 10:25 編輯

回復 9# BigDog
2016/4/26 更新

Option Explicit
Sub 鉅亨網_董監持股()
Dim ie As Object, A As Object, T As Date, i As Integer, c As Integer
Dim Code As String, xMonth As String
Code = InputBox("輸入股票代號 : ", "股票代號", 2303)
xMonth = InputBox("輸入年月 : ", "年月", Format(DateAdd("M", -2, Date), "yyyy年m月"))
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "http://www.cnyes.com/twstock/directorholder/" & Code & ".htm"
' ie.Visible = True
Do While ie.Busy Or ie.ReadyState <> 4: DoEvents: Loop
With ie.Document
With .getElementById("ctl00_ContentPlaceHolder1_DropDownList1")
.Value = xMonth
.fireEvent ("onchange")
End With
Do While ie.Busy Or ie.ReadyState <> 4
DoEvents
Loop
On Error Resume Next
Do
DoEvents
Set A = .getelementsbytagname("table")(1)
If Not A Is Nothing Then
If InStr(A.innertext, Format(xMonth, "YYYYM")) Then
If Err Then
Debug.Print Err
Err.Clear
Else
Exit Do
End If
End If
End If
Loop
On Error GoTo 0
Cells.Clear
Cells(1, "A").Resize(, 4) = Array("股票代號", Code, "月份", xMonth)
For i = 0 To A.Rows.Length - 1
For c = 0 To A.Rows(i).Cells.Length - 1
Cells(i + 2, c + 1) = A.Rows(i).Cells(c).innertext
Next
Next
End With
ie.Quit
MsgBox "OK"
End Sub

複製代碼

作者: BigDog 時間: 2013-10-16 16:24

回復 2# yuhuahsiao

Hi Y大您好,
      我使用錄製巨集,但網址顯示也是 ActiveSheet.QueryTables.Add(Connection:= _
      "URL;http://www.cnyes.com/twstock/directorholder/1101.htm", Destination:= _
      Range("$A$1"))
以網址來看,只能更改股票代號,月份方面就無法更改...
請問我該如何使用VBA,在儲存格輸入月份,就會帶出資料...請幫忙解惑.

謝謝^^
BigDog

作者: BigDog 時間: 2013-10-16 16:32

回復 11# GBKEE

感謝G大,收下研究,^^

作者: omit 時間: 2013-11-18 00:27

超級版主您好
我在run...每日收盤資料那個巨集...出現無法執行
用除錯找出... .Refresh BackgroundQuery:=False
那是否要更改為 true

作者: GBKEE 時間: 2013-11-18 06:27

回復 14# omit
你可試試看,如不行可上傳檔案看看

作者: omit 時間: 2013-11-24 21:13

超級版主您好
我想請問一個問題:
我有一筆匯整資料資料由A2:Z2, A2是顯示日期與時間, B2:Z2是變數的值
我在同一個 SHEET抓取資料每隔5鐘用複製,選擇性貼(值)上到 A5:Z5做成一筆新資料
然後下一次手動 A6:Z6再貼上一次~~在下一次 A7:Z7 ,但覺得很不方便
(可是用巨集錄製無法更改時間變化)
我想寫 VBA 可以每間隔5分鐘自動更新一次之後,就抓取這一筆資料然後可以自動抓取30次
不知如何做,可請版主解惑一下....還在學VBA的語法中.....@@

作者: c_c_lai 時間: 2013-11-25 07:12

回復 16# omit
網站上有很多有關此類的論述，譬如：
http://forum.twbts.com/viewthread.php?tid=6706&extra=&page=1

作者: omit 時間: 2013-11-26 13:57

回復 17# c_c_lai

謝謝大大您的回覆喔感恩感恩

作者: yopoyuan 時間: 2013-12-9 21:50 標題: 股價代號和起始日期的抓取

各位老師你好

http://www.cnyes.com/twstock/ps_historyprice/1101.htm

我想抓取上述網頁的資料,無奈網址只有秀出股價代號

但是網頁中的起始日我想自己設定,網頁中的原始碼我看不董

所以,無從抓取他的url請高手幫忙遺下

感恩

作者: GBKEE 時間: 2013-12-10 17:17

回復 19# yopoyuan
將你的發問合併在[指定下載3年歷史股價的資料] ,請從第1帖看起.

作者: BigDog 時間: 2014-3-8 22:31

回復 11# GBKEE

超版大,你好
請問我使用抓去年的"鉅亨網_董監持股"都沒問題,但目前有二個問題請超版大解惑,謝謝.
1.) 一次抓2013年9月到2014年2月就會直接抓到2014年2月的資料.
2.) RUN的過程,有時會出現"Automation錯誤"

作者: frankchen7 時間: 2016-4-25 19:52

回復 4# GBKEE

Hello GBKEE版大您好，目前上述方式已無法擷取三年的資訊了，我應該如何確認要修改那些參數?
我從網頁原始碼中找到與起始日期有關的資訊如下，但還是不知道該如何填入:L
<script type="text/javascript" charset="utf-8">
$(document).ready(
      function(){
      addDatePicker();
      }
);
function addDatePicker()
{
      jQuery(
      function($){
$("#ctl00_ContentPlaceHolder1_startText").datepicker();
$("#ctl00_ContentPlaceHolder1_endText").datepicker();
});

$("#ctl00_ContentPlaceHolder1_startText").keypress(function(){
                        return false;
                     }).datepicker();
         $("#ctl00_ContentPlaceHolder1_endText").keypress(function(){
                        return false;
                     }).datepicker();
}
</script>

作者: frankchen7 時間: 2016-4-26 14:00

回復 22# frankchen7
謝謝GBKEE版大的提示，我修改成下面的方式已可正常抓取
Sub 鉅亨網_歷史行情()
Dim Sh As Worksheet, Code As String, d_Start As String, d_End  As String
Dim A As Object, i As Integer, c As Integer, T As Date
Code = InputBox("輸入股票代號:", "股票代號", 2303)
d_End = InputBox("輸入結束日期", "結束日期", Date)
If Len(Code) <= 3 Or Not IsDate(d_End) Then Exit Sub
Set Sh = ActiveSheet
With Sh
      .UsedRange.Clear
      .[a1] = "股票代碼"
      .[b1] = "起始日期"
      .[c1] = "結束日期"
      .[a2] = Code
      .[b2] = DateAdd("yyyy", -3, d_End)  '下載三年的歷史股價
      .[c2] = d_End
      Code = .[a2]
      d_Start = Format(.[b2], "yyyy/mm/dd")
      d_End = Format(.[c2], "yyyy/mm/dd")
End With
With CreateObject("InternetExplorer.application")
      .Navigate "http://www.cnyes.com/twstock/ps_historyprice/" & Code & ".htm"
      .Visible = True
      Application.StatusBar = Code & "歷史行情等候中..."
      Do While .Busy Or .readyState <> 4
         DoEvents
      Loop
         With .Document
            .all("code").Value = Code '填入代碼 (不需要多餘的)
            .all("ctl00$ContentPlaceHolder1$startText").Value = d_Start '填入起始時間
            .all("ctl00$ContentPlaceHolder1$endText").Value = d_End '填入結束時間
            For Each E In .GetElementsByName("ctl00$ContentPlaceHolder1$submitBut")
            If E.Value = "查詢" Then E.Click '送出查詢鍵
            Next
         End With

      T = TIME
      Do
         DoEvents
      Loop Until TIME > T + #12:00:08 AM#
      Set A = .Document.GetElementsByTagName("table")(1)
      Application.StatusBar = Code & "歷史行情下載中..."
      Cells(2, 1) = .Document.GetElementsByTagName("span")(79).innertext
      For i = 0 To A.Rows.Length - 1
         For c = 0 To A.Rows(i).Cells.Length - 1
            Sh.Cells(i + 3, c + 1) = A.Rows(i).Cells(c).innertext
         Next
'       .Navigate "http://forum.twbts.com/tag.php?name=網頁元素"
'    .Visible = True

      Next
   .Quit
End With
Application.StatusBar = Code & "歷史行情" & Application.Text(TIME - T, "[S] 秒") & "下載完成"
MsgBox "OK"
Application.StatusBar = False
End Sub
:D

作者: bioleon69 時間: 2017-4-29 09:21

感謝gbk frankchen7 兩位前人分享
學習中~

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