12
返回列表 上一主題 發帖

[發問] 有辦法將每日資料會成一份嘛

pupai

帖子
184 
主題
45 
精華
0 
積分
407 
點名
0  
作業系統
WIN 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2010-8-19 
最後登錄
2025-6-26 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-9-20 09:47 | 顯示全部帖子

[發問] 有辦法將每日資料會成一份嘛

您好
我希望可以把每日的資料彙整成一份
請大家幫嘛指導
謝謝!!
  1. Sub GetData()

  3.     Dim DataSheet As Worksheet
  4.     Dim EndDate As Date
  5.     Dim StartDate As Date
  6.     Dim Symbol As String
  7.     Dim qurl As String
  8.     Dim nQuery As Name
  9.    
  10.     Application.ScreenUpdating = False
  11.     Application.DisplayAlerts = False
  12.     Application.Calculation = xlCalculationManual
  13.    
  14.     Set DataSheet = ActiveSheet
  15.   
  16.         StartDate = DataSheet.Range("B1").Value
  17.         EndDate = DataSheet.Range("B2").Value
  18.         Symbol = DataSheet.Range("B3").Value
  19.         Range("C7").CurrentRegion.ClearContents
  20.         
  21.         qurl = "http://www.twse.com.tw/ch/trading/exchange/BWIBBU/BWIBBU.php?" & Symbol
  22.         qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
  23.             "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
  24.             Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Range("E3") & "&q=q&y=0&z=" & _
  25.             Symbol & "&x=.csv"
  26.                   
  27. QueryQuote:
  28.             With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("C7"))
  29.                  .AdjustColumnWidth = False
  30.                 .BackgroundQuery = True
  31.                 .TablesOnlyFromHTML = False
  32.                 .Refresh BackgroundQuery:=False
  33.                 .SaveData = True
  34.                
  35.             End With
  36.             
  37.             Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _
  38.                 TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
  39.                 Semicolon:=False, Comma:=True, Space:=False, other:=False
  40.             
  41.             Range(Range("C7"), Range("C7").End(xlDown)).NumberFormat = "yyyy/mm/dd"
  42.             Range(Range("D7"), Range("G7").End(xlDown)).NumberFormat = "0.00"

  44. End Sub
複製代碼

test.rar (30.19 KB)

收藏 分享

pupai

帖子
184 
主題
45 
精華
0 
積分
407 
點名
0  
作業系統
WIN 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2010-8-19 
最後登錄
2025-6-26 

論壇贊助勳章
2#
發表於 2013-9-20 12:02 | 顯示全部帖子
回復 2# GBKEE


    G大還是不行
  1. Sub GetData()

  3.     Dim DataSheet As Worksheet
  4.     Dim EndDate As Date
  5.     Dim StartDate As Date
  6.     Dim Symbol As String
  7.     Dim qurl As String
  8.     Dim nQuery As Name
  9.    
  10.     Application.ScreenUpdating = False
  11.     Application.DisplayAlerts = False
  12.     Application.Calculation = xlCalculationManual
  13.    
  14.     Set DataSheet = ActiveSheet
  15.   
  16.         StartDate = DataSheet.Range("B1").Value
  17.         EndDate = DataSheet.Range("B2").Value
  18.         Symbol = DataSheet.Range("B3").Value
  19.         Range("C7").CurrentRegion.ClearContents
  20.         
  21.         qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
  22.             "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
  23.             Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Range("E3") & "&q=q&y=0&z=" & _
  24.             Symbol & "&x=.csv"
  25.             '*** 上面的網址qurl 為何要 a= b= c= d= e= 這些  ******
  26.              qurl = "http://www.twse.com.tw/ch/trading/exchange/BWIBBU/BWIBBU.php?myear=2013&mmon=9&STK_NO=2371"   
  27.                   
  28. QueryQuote:
  29.             With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("C7"))
  30.                  .AdjustColumnWidth = False
  31.                 .BackgroundQuery = True
  32.                 .TablesOnlyFromHTML = False
  33.                 .Refresh BackgroundQuery:=False
  34.                 .SaveData = True
  35.                
  36.             End With
  37.             
  38.             Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _
  39.                 TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
  40.                 Semicolon:=False, Comma:=True, Space:=False, other:=False
  41.             
  42.             Range(Range("C7"), Range("C7").End(xlDown)).NumberFormat = "yyyy/mm/dd"
  43.             Range(Range("D7"), Range("G7").End(xlDown)).NumberFormat = "0.00"

  45. End Sub
複製代碼

未命名.JPG (185.66 KB)

未命名.JPG

TOP

pupai

帖子
184 
主題
45 
精華
0 
積分
407 
點名
0  
作業系統
WIN 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2010-8-19 
最後登錄
2025-6-26 

論壇贊助勳章
3#
發表於 2013-9-20 12:37 | 顯示全部帖子
回復 4# GBKEE


    不懂
可否詳細說明
謝謝!!

TOP

pupai

帖子
184 
主題
45 
精華
0 
積分
407 
點名
0  
作業系統
WIN 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2010-8-19 
最後登錄
2025-6-26 

論壇贊助勳章
4#
發表於 2013-9-20 13:30 | 顯示全部帖子
回復 4# GBKEE

G大
    那請問有辦法把http://www.twse.com.tw/ch/trading/exchange/BWIBBU/BWIBBU.php的資料
用VB的方式作成可以查詢股票代碼且有連續時間的一份資料(比方:2009/01/01到2013/09/18 )
謝謝

TOP

pupai

帖子
184 
主題
45 
精華
0 
積分
407 
點名
0  
作業系統
WIN 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2010-8-19 
最後登錄
2025-6-26 

論壇贊助勳章
5#
發表於 2013-9-20 21:05 | 顯示全部帖子
回復 7# GBKEE


請教 G大
根據上面執行後startdate與enddate好像有問題
跑不出來
結果如附件
謝謝!!

未命名.JPG (190.29 KB)

未命名.JPG

TOP

pupai

帖子
184 
主題
45 
精華
0 
積分
407 
點名
0  
作業系統
WIN 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2010-8-19 
最後登錄
2025-6-26 

論壇贊助勳章
6#
發表於 2013-9-21 08:24 | 顯示全部帖子
回復 9# GBKEE


    可以了~~感恩!!

TOP

pupai

帖子
184 
主題
45 
精華
0 
積分
407 
點名
0  
作業系統
WIN 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2010-8-19 
最後登錄
2025-6-26 

論壇贊助勳章
7#
發表於 2013-9-21 14:02 | 顯示全部帖子
回復 10# pupai


    謝謝GBKEE版主的分享
兩個問題請教
1.D欄文字轉數字
2.另外下載完後的資料，自動儲存到另一個SHEET（以股票命名）
謝謝您

TOP

pupai

帖子
184 
主題
45 
精華
0 
積分
407 
點名
0  
作業系統
WIN 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2010-8-19 
最後登錄
2025-6-26 

論壇贊助勳章
8#
發表於 2013-9-21 15:14 | 顯示全部帖子
回復 12# GBKEE


    GBKEE版主
我有用巨集完成(如附件)
1.D欄文字轉數字
2.下載完後的資料，自動儲存到另一個SHEET（以股票命名）
但我寫知道VBA要如何完成上面的動作
另外我有個新問題
如果我在一個代碼分頁中(A1欄輸入股票代碼1101,1102,1103,1104,1108,1109,1110,1201,1203…等等)
VBA可以產生一個迴圈一次幫我跑完這一些股票代碼的歷年資料，並再自動儲存在另一個SHEET（以股票命名）？
謝謝!!

個股日本益比、殖利率及股價淨值比.rar (18.04 KB)

TOP

pupai

帖子
184 
主題
45 
精華
0 
積分
407 
點名
0  
作業系統
WIN 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2010-8-19 
最後登錄
2025-6-26 

論壇贊助勳章
9#
發表於 2013-9-21 20:41 | 顯示全部帖子
回復 14# GBKEE


    G大您好
再次感謝您的熱心的指導
我研究看看
謝謝...

TOP

pupai

帖子
184 
主題
45 
精華
0 
積分
407 
點名
0  
作業系統
WIN 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2010-8-19 
最後登錄
2025-6-26 

論壇贊助勳章
10#
發表於 2013-9-21 21:00 | 顯示全部帖子
  1. 程式我大概說明一下

  3. Option Explicit
  4. Sub GetData()
  5.     Dim DataSheet As Worksheet, Sh As Worksheet, Msg As Boolean               '定義變數
  6.     Dim EndDate As Date, StartDate As Date, i As Integer, AR, xR As Long    '定義變數
  7.     Dim Symbol As String, Qur As String                                                            '定義變數
  8.     Set DataSheet = Sheets("Sheet1")                                                                   '設定工作表名稱
  9.     With DataSheet
  10.         StartDate = .[b1]                                                                                          '將B1欄位值讀到變數StartDate中
  11.         EndDate = .[b2]                                                                                           '將B2欄位值讀到變數EndDate中
  12.         Symbol = .[b3]                                                                                             '將B3欄位值讀到變數Symbol中
  13.         .Range("D1").CurrentRegion = ""                                                               '設定D1欄位值
  14.     End With
  15.     '本資料自民國94年09月01日開始提供 *** 除錯  ***                                '以下以94/09/01為界限,判讀輸入值是否有錯
  16.     If StartDate < #9/1/2005# Or EndDate < #9/1/2005# Or Len(Symbol) <= 3 Or StartDate > EndDate Or EndDate > Date Then
  17.         MsgBox "數據有誤" & IIf(StartDate < #9/1/2005#, vbLf & "StartDate :日期 小於 94年09月01日  ", "") & _
  18.         IIf(EndDate < #9/1/2005#, vbLf & "EndDate :日期 小於 94年09月01日  ", "") & _
  19.         IIf(Len(Symbol) <= 3, vbLf & "Symbol : 股票代號 ", "") & _
  20.         IIf(StartDate > EndDate, vbLf & "StartDate > EndDate", "") & _
  21.         IIf(EndDate > Date, vbLf & " EndDate >" & Date, "")
  22.         Exit Sub
  23.     End If
  24.     '*********************************************
  25.     Set Sh = Sheets.Add(Sheets(1))
  26.     DataSheet.Activate
  27.     Do While DateSerial(Year(StartDate), Month(StartDate), 1) <= EndDate   ' DO到LOOP中的程式為以輸入值去抓取網頁的資料
  28.         Qur = "http://www.twse.com.tw/ch/trading/exchange/BWIBBU/BWIBBU.php?myear=" & Format(StartDate, "yyyy") & "&mmon=" & Format(StartDate, "m") & "&STK_NO=" & Symbol
  29.         With Sh
  30.             If .QueryTables.Count = 0 Then
  31.                 .QueryTables.Add "URL;" & Qur, .[A1]
  32.             Else
  33.                 .QueryTables(1).Connection = "URL;" & Qur
  34.                 Msg = True
  35.             End If
  36.            With .QueryTables(1)
  37.                 .WebFormatting = xlWebFormattingNone
  38.                 .WebSelectionType = xlSpecifiedTables
  39.                 .WebDisableDateRecognition = True
  40.                 .WebTables = "8"
  41.                  .Refresh BackgroundQuery:=False
  42.                  If Application.CountA(.ResultRange) = 0 Then Msg = False
  43.                  If Msg Then
  44.                     AR = .ResultRange.Offset(2)
  45.                  Else
  46.                     AR = .ResultRange
  47.                  End If
  48.                  With DataSheet
  49.                     xR = Application.CountA(.[d:d]) + 1
  50.                     .Cells(xR, "D").Resize(UBound(AR, 1), UBound(AR, 2)) = AR
  51.                  End With
  52.            End With
  53.            End With
  54.         StartDate = DateAdd("m", 1, StartDate)                            '這行就是能抓跨月的計算式,抓完第一個月後,變數StartDate的月份+1
  55.     Loop
  56.     Application.DisplayAlerts = False
  57.     Sh.Delete
  58.     Application.DisplayAlerts = True
  59. End Sub
複製代碼
分享G大的程式碼

TOP

        靜思自在 : 自己害自己，莫過於亂發脾氣。
12
返回列表 上一主題