返回列表 上一主題 發帖

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

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

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

  2.     Dim DataSheet As Worksheet
  3.     Dim EndDate As Date
  4.     Dim StartDate As Date
  5.     Dim Symbol As String
  6.     Dim qurl As String
  7.     Dim nQuery As Name
  8.    
  9.     Application.ScreenUpdating = False
  10.     Application.DisplayAlerts = False
  11.     Application.Calculation = xlCalculationManual
  12.    
  13.     Set DataSheet = ActiveSheet
  14.   
  15.         StartDate = DataSheet.Range("B1").Value
  16.         EndDate = DataSheet.Range("B2").Value
  17.         Symbol = DataSheet.Range("B3").Value
  18.         Range("C7").CurrentRegion.ClearContents
  19.         
  20.         qurl = "http://www.twse.com.tw/ch/trading/exchange/BWIBBU/BWIBBU.php?" & Symbol
  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.                   
  26. QueryQuote:
  27.             With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("C7"))
  28.                  .AdjustColumnWidth = False
  29.                 .BackgroundQuery = True
  30.                 .TablesOnlyFromHTML = False
  31.                 .Refresh BackgroundQuery:=False
  32.                 .SaveData = True
  33.                
  34.             End With
  35.             
  36.             Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _
  37.                 TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
  38.                 Semicolon:=False, Comma:=True, Space:=False, other:=False
  39.             
  40.             Range(Range("C7"), Range("C7").End(xlDown)).NumberFormat = "yyyy/mm/dd"
  41.             Range(Range("D7"), Range("G7").End(xlDown)).NumberFormat = "0.00"

  42. End Sub
複製代碼

test.rar (30.19 KB)

本帖最後由 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"         

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

TOP

回復 2# GBKEE


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

  2.     Dim DataSheet As Worksheet
  3.     Dim EndDate As Date
  4.     Dim StartDate As Date
  5.     Dim Symbol As String
  6.     Dim qurl As String
  7.     Dim nQuery As Name
  8.    
  9.     Application.ScreenUpdating = False
  10.     Application.DisplayAlerts = False
  11.     Application.Calculation = xlCalculationManual
  12.    
  13.     Set DataSheet = ActiveSheet
  14.   
  15.         StartDate = DataSheet.Range("B1").Value
  16.         EndDate = DataSheet.Range("B2").Value
  17.         Symbol = DataSheet.Range("B3").Value
  18.         Range("C7").CurrentRegion.ClearContents
  19.         
  20.         qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
  21.             "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
  22.             Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Range("E3") & "&q=q&y=0&z=" & _
  23.             Symbol & "&x=.csv"
  24.             '*** 上面的網址qurl 為何要 a= b= c= d= e= 這些  ******
  25.              qurl = "http://www.twse.com.tw/ch/trading/exchange/BWIBBU/BWIBBU.php?myear=2013&mmon=9&STK_NO=2371"   
  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"

  43. End Sub
複製代碼

未命名.JPG (185.66 KB)

未命名.JPG

TOP

本帖最後由 GBKEE 於 2013-9-20 12:27 編輯

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

TOP

回復 4# GBKEE


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

TOP

回復 4# GBKEE

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

TOP

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

回復 7# GBKEE


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

未命名.JPG (190.29 KB)

未命名.JPG

TOP

回復 8# pupai
沒有啊!
圖示為 執行 7# 程式碼 的結果


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

TOP

回復 9# GBKEE


    可以了~~感恩!!

TOP

        靜思自在 : 有多少力量就做多少事,不要心存等待,等待才會落空。
返回列表 上一主題