123456789
返回列表 上一主題 發帖

[分享] 大盤每月每天歷史成交量與金額下載

white5168

帖子
90 
主題
16 
精華
0 
積分
114 
點名
0  
作業系統
XP 
軟體版本
sp2 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-10-7 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-5-30 23:47 | 只看該作者

[分享] 大盤每月每天歷史成交量與金額下載

本帖最後由 white5168 於 2012-5-31 00:43 編輯

繼上次各股股價歷史資料下載,再一次分享 大盤歷史成交量下載
附件有 "大盤每月歷史成交量與金額下載" 檔, 歡迎各位先進試用看看
如有問題歡迎告知以便於修改,程式碼待大家覺得不錯用時,會稍後補上

大盤成交量下載.rar (19.38 KB)

大盤每月歷史成交量與金額下載

收藏 分享

white5168

帖子
90 
主題
16 
精華
0 
積分
114 
點名
0  
作業系統
XP 
軟體版本
sp2 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-10-7 
2#
發表於 2012-6-23 18:00 | 只看該作者
本帖最後由 white5168 於 2012-6-23 22:57 編輯

在Sheet1的程式碼
  1. Private Sub 大盤成交資訊_Click()
  2.     Dim Year As String
  3.     Dim Mon As String
  4.    
  5.     Year = Format(Range("C1"), "0000")  '修改字串格式
  6.     Mon = Format(Range("C2"), "00")     '修改字串格式
  7.     Call Run(Year, Mon)                 '呼叫Module1中的函數
  8. End Sub
複製代碼
在Module1的程式碼
  1. Sub Run(Year As String, Month As String)
  2.     Dim sheetName As String
  3.     sheetName = "Temp"
  4.    
  5.     If CheckSheetExist(sheetName) <> True Then      '確定Temp工作表是否存在,若不存在則呼叫AddTempSheet建立Temp工作表
  6.         Call AddTempSheet(sheetName)
  7.     End If
  8.    
  9.     Call ClearTempTablesData(sheetName)             '避免Temp工作表存在時資料格式未清除,而清除
  10.     Call GetPrice(sheetName, Year, Month)           '從TWSE取得大盤歷史資料
  11.     Call ClearsheetTablesData("Sheet1")             '清除原本在Sheet1工作表的資料
  12.     Call SetCellWidthSize(sheetName)                '設定TWSE取得的資料所造成的格式,將此格式調整為excel預設的儲存格格式
  13.     Call CopyDatatoSheet(sheetName)                 '將Temp工作表資料拷貝至Sheet1工作表
  14.     Call DeleteTempSheet(sheetName)                 '刪除Temp工作表   
  15.     Sheets("Sheet1").Select                         '將focus設定到Sheet1工作表
  16. End Sub

  18. Function CheckSheetExist(sheetName As String) As Boolean
  19.     Dim i As Integer
  20.     CheckSheetExist = False
  21.     For i = 1 To Worksheets.Count                   '取得目前工作表的數量
  22.         If sheetName = Worksheets(i).Name Then      '判斷指定的工作表名稱是否存在,存在則回傳找到工作表的訊息
  23.             CheckSheetExist = True                  '將找到的訊息設定至回傳值
  24.         End If
  25.     Next
  26. End Function

  28. Sub AddTempSheet(sheetName As String)
  29.     ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)   '建立指定工作到現存工作表的對後面
  30.     Worksheets(Worksheets.Count).Select                                 '選擇建立工作表
  31.     ActiveSheet.Name = sheetName                                        '修改工作表名稱
  32. End Sub

  34. Sub GetPrice(sheetName As String, Year As String, Month As String)
  35.    
  36.     Sheets(sheetName).UsedRange.Select              '選取指定工作表A1:H50的儲存格範圍
  37.     Selection.Clear                                 '清除所選取儲存格格式
  38.     Selection.ClearContents                         '清除所選取的資料
  39.     Sheets(sheetName).Range("A1").Select            '選取Temp工作表A1儲存格,避免使用QueryTable後,因為資料擠壓會造成儲存格右移,導致foucs不在A1儲存格上而發生錯誤訊息
  40.    

  42.     '以下就不多介紹,Excel相關內容
  43.     With ActiveSheet.QueryTables.Add(Connection:= _
  44.         "TEXT;http://www.twse.com.tw/ch/trading/exchange/FMTQIK/FMTQIK2.php?STK_NO=&myear=" & Year & "&mmon=" & Month & "&type=csv", _
  45.         Destination:=Range("A1"))
  46.         .Name = "大盤歷史資料"
  47.         .FieldNames = True
  48.         .RowNumbers = False
  49.         .FillAdjacentFormulas = False
  50.         .PreserveFormatting = True
  51.         .RefreshOnFileOpen = False
  52.         .RefreshStyle = xlInsertDeleteCells
  53.         .SavePassword = False
  54.         .SaveData = True
  55.         .AdjustColumnWidth = True
  56.         .RefreshPeriod = 0
  57.         .TextFilePromptOnRefresh = False
  58.         .TextFilePlatform = 950
  59.         .TextFileStartRow = 1
  60.         .TextFileParseType = xlDelimited
  61.         .TextFileTextQualifier = xlTextQualifierDoubleQuote
  62.         .TextFileConsecutiveDelimiter = False
  63.         .TextFileTabDelimiter = False
  64.         .TextFileSemicolonDelimiter = False
  65.         .TextFileCommaDelimiter = True
  66.         .TextFileSpaceDelimiter = False
  67.         .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
  68.         .TextFileTrailingMinusNumbers = True
  69.         .Refresh BackgroundQuery:=False                             '若沒有 Sheets(sheetName).Range("A1").Select,在此行會發生錯誤
  70.         If Err.Number <> 0 Then Err.Clear: MsgBox "資料查詢失敗"    '被免資料抓取不成功,而顯示訊息
  71.     End With
  72. End Sub

  74. Sub SetCellWidthSize(sheetName As String)
  75.     Dim n As Integer
  76.     Worksheets(sheetName).Select
  77.     n = ActiveSheet.Range("A1").End(xlDown).Row             '取得選取有存在資料的儲存格列數
  78.     ActiveSheet.Range("A1:F" & n).UseStandardWidth = True   '設定指定工作表的儲存格寬度為預設值
  79. End Sub
  80. Sub CopyDatatoSheet(sheetName As String)
  81.     Dim n As Integer
  82.    
  83.     Worksheets(sheetName).Select                            '選取指定名稱工作表
  84.     n = ActiveSheet.Range("A3").End(xlDown).Row - 1         '取得選取有存在資料的儲存格列數
  85.     ActiveSheet.Range("A3:F" & n).Copy                      '複製選取的儲存格資料
  86.    
  87.     Worksheets("Sheet1").Select                             '選取Sheet1工作表
  88.     Range("A5").Select                                      '選取A5儲存格
  89.     ActiveSheet.Paste                                       '貼上資料   
  90. End Sub

  92. Sub ClearsheetTablesData(sheetName As String)
  93.     Dim n As Integer
  94.     Dim qyt As QueryTable
  95.    
  96.     Worksheets(sheetName).Select
  97.     If ActiveSheet.Range("A5") <> "" Then                   '判斷目前的活頁簿是否有資料存在, 這行可以再寫的更謹慎,歡迎各位自行修改
  98.         n = ActiveSheet.Range("A5").End(xlDown).Row         '選取目前活頁簿從A4位置到最後一行的範圍
  99.         For Each qyt In ActiveSheet.QueryTables             '選取用QueryTables抓取的每一行
  100.             qyt.Delete                                      '將使用QueryTables方法所產生的行進行刪除,避免QueryTables用久了,造成系統堆積一堆QueryTables的垃圾,如此系統才部會變慢
  101.         Next
  102.         ActiveSheet.Range("A5:G" & n).Clear                 '清除所選取儲存格格式
  103.         ActiveSheet.Range("A5:G" & n).ClearContents         '清除所選取的資料
  104.     Else
  105.         ActiveSheet.Range("A5:G40").Clear                   '清除所選取儲存格格式
  106.         ActiveSheet.Range("A5:G40").ClearContents           '清除所選取的資料
  107.     End If
  108. End Sub

  110. Sub DeleteTempSheet(sheetName As String)
  111.     Worksheets(sheetName).Select
  112.     Application.DisplayAlerts = False                       '關閉警告視窗
  113.     Worksheets(sheetName).Delete                            '刪除作用中的工作表
  114.     Application.DisplayAlerts = True                        '恢復警告視窗
  115. End Sub

  117. Sub ClearTempTablesData(sheetName As String)
  118.     Dim n As Integer
  119.     Dim qyt As QueryTable
  120.    
  121.     Worksheets(sheetName).Select                            '選取指定名稱工作表
  122.     If ActiveSheet.Range("A1") <> "" Then
  123.         n = ActiveSheet.Range("A1").End(xlDown).Row         '選取目前活頁簿從A1位置到最後一行的範圍
  124.         For Each qyt In Worksheets(sheetName).QueryTables   '選取用QueryTables抓取的每一行
  125.             qyt.Delete                                      '將使用QueryTables方法所產生的行進行刪除,避免QueryTables用久了,造成系統堆積一堆QueryTables的垃圾,如此系統才部會變慢
  126.         Next
  127.         ActiveSheet.Range("A1:F" & n).Clear                 '清除所選取儲存格格式
  128.         ActiveSheet.Range("A1:F" & n).ClearContents         '清除所選取的資料
  129.     Else
  130.         ActiveSheet.UsedRange.Clear                         '清除所選取儲存格格式
  131.         ActiveSheet.UsedRange.ClearContents                 '清除所選取的資料
  132.     End If
  133. End Sub
複製代碼

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 2012-6-23 21:35 | 只看該作者
本帖最後由 GBKEE 於 2012-6-24 08:41 編輯

回復 2# white5168
要分享記得專案請不要不上鎖
SHEET1的程式碼
  1. Private Sub 大盤成交資訊_Click()
  2.     Dim xlTheYear As String, xlTheMonth As String, xlTheFile As String
  3.     xlTheYear = Format(Range("C1"), "0000")  '修改字串格式
  4.     xlTheMonth = Format(Range("C2"), "00")     '修改字串格式
  5.     UsedRange.Offset(4).Clear
  6.     xlTheFile = "http://www.twse.com.tw/ch/trading/exchange/FMTQIK/FMTQIK2.php?STK_NO=&myear=" & xlTheYear & "&mmon=" & xlTheMonth & "&type=csv"
  7.     With Workbooks.Open(xlTheFile)
  8.         .Sheets(1).UsedRange.Offset(2).Copy [a5]
  9.         .Close 0
  10.     End With
  11. End Sub
複製代碼

TOP

white5168

帖子
90 
主題
16 
精華
0 
積分
114 
點名
0  
作業系統
XP 
軟體版本
sp2 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-10-7 
4#
發表於 2012-6-23 22:41 | 只看該作者
本帖最後由 white5168 於 2012-6-23 23:03 編輯

版主,請問有自行確認過以上程式碼是可以將資料成功產生在sheet1嗎?

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2012-6-24 08:10 | 只看該作者
回復 4# white5168
試試看

    大盤每月每天歷史..rar (7.64 KB)

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
6#
發表於 2012-6-24 08:29 | 只看該作者
回復 3# GBKEE
蠻不錯的寫法！
一支 Private Sub 大盤成交資訊_Click() 就完成了所有的作業。

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2012-6-25 20:33 | 只看該作者
回復 7# usana642
1.複製程式碼到 一般模駔,或 ThisWorkbook模駔    2.在工作表上 插入快取圖案,   3.將圖案的巨集指定此程序
於工作表 的 C1 :  輸入西元年份   C2 :  輸入月份    按下 快取圖案 就可以
  1. Sub 大盤成交資訊()
  2.     Dim xlTheYear As String, xlTheMonth As String, xlTheFile As String
  3.     xlTheYear = Format(Range("C1"), "0000")  '修改字串格式
  4.     xlTheMonth = Format(Range("C2"), "00")     '修改字串格式
  5.     UsedRange.Offset(4).Clear
  6.     xlTheFile = "http://www.twse.com.tw/ch/trading/exchange/FMTQIK/FMTQIK2.php?STK_NO=&myear=" & xlTheYear & "&mmon=" & xlTheMonth & "&type=csv"
  7.     With Workbooks.Open(xlTheFile)
  8.         .Sheets(1).UsedRange.Offset(2).Copy [a5]
  9.         .Close 0
  10.     End With
  11. End Sub
複製代碼

TOP

white945

帖子
23 
主題
0 
精華
0 
積分
31 
點名
0  
作業系統
Win7 
軟體版本
20xx 
閱讀權限
10 
性別
男 
註冊時間
2012-8-11 
最後登錄
2012-8-28 
8#
發表於 2012-8-11 23:55 | 只看該作者
回復 4# white5168

版大辛苦簡化的程式碼，難道你沒測試看看?
枉費版大的教學
給GBKEE版主按個讚

TOP

turbine

帖子
36 
主題
9 
精華
0 
積分
79 
點名
0  
作業系統
windows 
軟體版本
xp 
閱讀權限
20 
註冊時間
2010-5-25 
最後登錄
2015-8-13 
9#
發表於 2012-10-1 11:35 | 只看該作者
哇！超方便的~~~
謝謝大大的分享~
尤其謝謝GBKEE版主的簡易版~~~
但小弟現在有一個問題...要怎麼寫出一個程式，需求是：
下載完後的資料，自動儲存到另一個SHEET（總表），
下載另一時期的資料後，再自動儲存在總表內空白儲存格？
並且是向下儲存這樣？

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 2012-10-2 10:52 | 只看該作者
回復 9# turbine
  1. Option Explicit
  2. Private Sub 大盤成交資訊()
  3.     Dim xlTheYear As String, xlTheMonth As String, xlTheFile As String
  4.     Dim Sh As Worksheet
  5.     xlTheYear = Format(Range("C1"), "0000")  '修改字串格式
  6.     xlTheMonth = Format(Range("C2"), "00")   '修改字串格式
  7.     Set Sh = ThisWorkbook.Sheets.Add         '新增工作表
  8.     Sh.Name = xlTheYear & "_" & xlTheMonth   '新增工作表命名
  9.     xlTheFile = "http://www.twse.com.tw/ch/trading/exchange/FMTQIK/FMTQIK2.php?STK_NO=&myear=" & xlTheYear & "&mmon=" & xlTheMonth & "&type=csv"
  10.     With Workbooks.Open(xlTheFile)
  11.         .Sheets(1).UsedRange.Copy Sh.[a1]
  12.         .Close 0
  13.     End With
  14.     Sh.Cells.EntireColumn.AutoFit            '調整欄寬
  15.     Sh.Columns("A:A").ColumnWidth = 28.56
  16. End Sub
複製代碼

TOP

        靜思自在 : 虛空有盡．我願無窮，發願容易行願難。
123456789
返回列表 上一主題