123
返回列表 上一主題 發帖

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

pupai

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

論壇贊助勳章
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)

收藏 分享

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2013-9-20 11:17 | 只看該作者
本帖最後由 GBKEE 於 2013-9-20 11:47 編輯

回復 1# pupai
如何每日資料匯成一份??
  1. 你的網址少了 STK_NO (股票代號)
  2. 'qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
  3.             "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
  4.             Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Range("E3") & "&q=q&y=0&z=" & _
  5.             Symbol & "&x=.csv"
  6.             '*** 上面的網址qurl 為何要 a= b= c= d= e= 這些  ******
  7.              qurl = "http://www.twse.com.tw/ch/trading/exchange/BWIBBU/BWIBBU.php?myear=2013&mmon=9&STK_NO=2371"         

  9.             
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

pupai

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

論壇贊助勳章
3#
發表於 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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2013-9-20 12:25 | 只看該作者
本帖最後由 GBKEE 於 2013-9-20 12:27 編輯

回復 3# pupai
請詳看圖示的錯誤信息,去看看儲存格的範圍,不知你要如何每日資料匯成一份??
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

pupai

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

論壇贊助勳章
5#
發表於 2013-9-20 12:37 | 只看該作者
回復 4# GBKEE


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

TOP

pupai

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

論壇贊助勳章
6#
發表於 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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2013-9-20 16:20 | 只看該作者
回復 6# pupai
  1. Option Explicit
  2. Sub GetData()
  3.     Dim DataSheet As Worksheet, Sh As Worksheet, Msg As Boolean
  4.     Dim EndDate As Date, StartDate As Date, i As Integer, AR, xR As Long
  5.     Dim Symbol As String, Qur As String
  6.     Set DataSheet = Sheets("Sheet1")
  7.     With DataSheet
  8.         StartDate = .[b1]
  9.         EndDate = .[b2]
  10.         Symbol = .[b3]
  11.         .Range("D1").CurrentRegion = ""
  12.     End With
  13.     '本資料自民國94年09月01日開始提供 *** 除錯  ***
  14.     If StartDate < #9/1/2005# Or EndDate < #9/1/2005# Or Len(Symbol) <= 3 Or StartDate > EndDate Or EndDate > Date Then
  15.         MsgBox "數據有誤" & IIf(StartDate < #9/1/2005#, vbLf & "StartDate :日期 小於 94年09月01日  ", "") & _
  16.         IIf(EndDate < #9/1/2005#, vbLf & "EndDate :日期 小於 94年09月01日  ", "") & _
  17.         IIf(Len(Symbol) <= 3, vbLf & "Symbol : 股票代號 ", "") & _
  18.         IIf(StartDate > EndDate, vbLf & "StartDate > EndDate", "") & _
  19.         IIf(EndDate > Date, vbLf & " EndDate >" & Date, "")
  20.         Exit Sub
  21.     End If
  22.     '*********************************************
  23.     Set Sh = Sheets.Add(Sheets(1))
  24.     DataSheet.Activate
  25.     Do While DateSerial(Year(StartDate), Month(StartDate), 1) <= EndDate
  26.         Qur = "http://www.twse.com.tw/ch/trading/exchange/BWIBBU/BWIBBU.php?myear=" & Format(StartDate, "yyyy") & "&mmon=" & Format(StartDate, "m") & "&STK_NO=" & Symbol
  27.         With Sh
  28.             If .QueryTables.Count = 0 Then
  29.                 .QueryTables.Add "URL;" & Qur, .[A1]
  30.             Else
  31.                 .QueryTables(1).Connection = "URL;" & Qur
  32.                 Msg = True
  33.             End If
  34.            With .QueryTables(1)
  35.                 .WebFormatting = xlWebFormattingNone
  36.                 .WebSelectionType = xlSpecifiedTables
  37.                 .WebDisableDateRecognition = True
  38.                 .WebTables = "8"
  39.                  .Refresh BackgroundQuery:=False
  40.                  If Application.CountA(.ResultRange) = 0 Then Msg = False
  41.                  If Msg Then
  42.                     AR = .ResultRange.Offset(2)
  43.                  Else
  44.                     AR = .ResultRange
  45.                  End If
  46.                  With DataSheet
  47.                     xR = Application.CountA(.[d:d]) + 1
  48.                     .Cells(xR, "D").Resize(UBound(AR, 1), UBound(AR, 2)) = AR
  49.                  End With
  50.            End With
  51.            End With
  52.         StartDate = DateAdd("m", 1, StartDate)
  53.     Loop
  54.     Application.DisplayAlerts = False
  55.     Sh.Delete
  56.     Application.DisplayAlerts = True
  57. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

pupai

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

論壇贊助勳章
8#
發表於 2013-9-20 21:05 | 只看該作者
回復 7# GBKEE


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

未命名.JPG (190.29 KB)

未命名.JPG

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
9#
發表於 2013-9-21 07:03 | 只看該作者
回復 8# pupai
沒有啊!
圖示為 執行 7# 程式碼 的結果


感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

pupai

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

論壇贊助勳章
10#
發表於 2013-9-21 08:24 | 只看該作者
回復 9# GBKEE


    可以了~~感恩!!

TOP

        靜思自在 : 布施如播種，以歡喜心滋潤種子，才會發芽。
123
返回列表 上一主題