123
返回列表 上一主題 發帖

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

pupai

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

論壇贊助勳章
11# 跳轉到 »
發表於 2013-9-21 14:02 | 只看該作者
回復 10# pupai


    謝謝GBKEE版主的分享
兩個問題請教
1.D欄文字轉數字
2.另外下載完後的資料，自動儲存到另一個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兔年全勤獎章
12#
發表於 2013-9-21 14:25 | 只看該作者
回復 11# pupai
這都可以用巨集錄製試試看,練習才會進步的.
************************************
1.新增一工作表,將之命名為股票代號.         
2將下載的資料,複製到,此新工作表
*************************************
1.原程式中有新增工作表,可將之命名為股票代號.
2,將下載的資料,複製到,此新增工作表
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

pupai

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

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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
14#
發表於 2013-9-21 16:28 | 只看該作者
回復 13# 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, AR, xR As Long
  5.     Dim Symbol As Variant, Qur As String
  6.     Set DataSheet = Sheets("代碼")
  7.     With DataSheet
  8.         StartDate = .[C1]
  9.         EndDate = .[C2]
  10.         '本資料自民國94年09月01日開始提供 *** 除錯  ***
  11.         If StartDate < #9/1/2005# Or EndDate < #9/1/2005# Or StartDate > EndDate Or EndDate > Date Then
  12.             MsgBox "數據有誤" & IIf(StartDate < #9/1/2005#, vbLf & "StartDate :日期 小於 94年09月01日  ", "") & _
  13.             IIf(EndDate < #9/1/2005#, vbLf & "EndDate :日期 小於 94年09月01日  ", "") & _
  14.             IIf(StartDate > EndDate, vbLf & "StartDate > EndDate", "") & _
  15.             IIf(EndDate > Date, vbLf & " EndDate >" & Date, "")
  16.             Exit Sub
  17.         End If
  18.     '*********************************************
  19.         Application.DisplayAlerts = False
  20.         For Each Sh In Sheets
  21.             If Sh.Name <> DataSheet.Name Then Sh.Delete    '刪除不必要的工作
  22.         Next
  23.         For Each Symbol In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))  '股票的迴圈
  24.             Msg = False
  25.             StartDate = .[C1]                           '迴圈需重新回到原本的 StartDate日期
  26.             Set Sh = Sheets.Add(, Sheets(Sheets.Count)) '新增的工作表位於活頁簿最後面(Sheets.Count)
  27.             DataSheet.Activate
  28.             
  29.             Do While DateSerial(Year(StartDate), Month(StartDate), 1) <= EndDate
  30.                 Qur = "http://www.twse.com.tw/ch/trading/exchange/BWIBBU/BWIBBU.php?myear=" & Format(StartDate, "yyyy") & "&mmon=" & Format(StartDate, "m") & "&STK_NO=" & Symbol
  31.                 With Sh       '新增的工作表
  32.                     If .QueryTables.Count = 0 Then                      'Web查詢
  33.                         .QueryTables.Add "URL;" & Qur, .[M1]            'Web查詢資料在M欄
  34.                     Else
  35.                         .QueryTables(1).Connection = "URL;" & Qur
  36.                         Msg = True
  37.                     End If
  38.                     With .QueryTables(1)
  39.                         .WebFormatting = xlWebFormattingNone
  40.                         .WebSelectionType = xlSpecifiedTables
  41.                         .WebDisableDateRecognition = True
  42.                         .WebTables = "8"
  43.                         .Refresh BackgroundQuery:=False
  44.                         If Application.CountA(.ResultRange) = 0 Then Msg = False
  45.                         If Msg Then
  46.                             AR = .ResultRange.Offset(2)
  47.                         Else
  48.                             AR = .ResultRange
  49.                         End If
  50.                         xR = Application.CountA(.Parent.[d:d]) + 1                         '.Parent :Web查詢的父層
  51.                         .Parent.Cells(xR, "A").Resize(UBound(AR, 1), UBound(AR, 2)) = AR   '資料複製到 新增工作表的A欄
  52.                     End With
  53.                 End With
  54.                 StartDate = DateAdd("m", 1, StartDate)   '日期 + 1個月
  55.             Loop
  56.             With Sh
  57.                 .Name = Symbol                                 '以股票命名
  58.                 .QueryTables(1).ResultRange = ""               '清除Web查詢的資料
  59.                  .Names(.QueryTables(1).Name).Delete           'Web查詢的名稱
  60.             End With
  61.         Next
  62.     End With
  63.     Application.DisplayAlerts = True
  64. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

pupai

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

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


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

TOP

pupai

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

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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
17#
發表於 2013-9-21 21:13 | 只看該作者
回復 16# pupai
你還是沒搞清楚CurrentRegion是什麼,須多看vba的說明.
  1.   .Range("D1").CurrentRegion = ""                                                               '設定D1欄位值
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

pupai

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

論壇贊助勳章
18#
發表於 2013-9-22 12:04 | 只看該作者
回復 17# GBKEE


    呵呵....苦笑 我再努力.   受教了

TOP

pupai

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

論壇贊助勳章
19#
發表於 2013-10-23 11:29 | 只看該作者

如何避免當查詢日期 小於 資料日期時 程式中斷

您好
代碼1773的歷史資料從2009/2/27開始有資料
假設我在StartDate打入2006/1/1
當程式執行到1773就會中斷
請問要如何修改
謝謝!!

test.rar (18.45 KB)

TOP

GBKEE

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

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

回復 19# pupai
  1. Option Explicit
  2. Sub GetData()
  3.     Dim DataSheet As Worksheet, Sh As Worksheet
  4.     Dim EndDate As Date, StartDate As Date, AR, xR As Long
  5.     Dim Symbol As Variant, Qur As String
  6.     Set DataSheet = Sheets("代碼")
  7.     With DataSheet
  8.         StartDate = .[C1]
  9.         EndDate = .[C2]
  10.         '本資料自民國94年09月01日開始提供 *** 除錯  ***
  11.         If StartDate < #9/1/2005# Or EndDate < #9/1/2005# Or StartDate > EndDate Or EndDate > Date Then
  12.             MsgBox "數據有誤" & IIf(StartDate < #9/1/2005#, vbLf & "StartDate :日期 小於 94年09月01日  ", "") & _
  13.             IIf(EndDate < #9/1/2005#, vbLf & "EndDate :日期 小於 94年09月01日  ", "") & _
  14.             IIf(StartDate > EndDate, vbLf & "StartDate > EndDate", "") & _
  15.             IIf(EndDate > Date, vbLf & " EndDate >" & Date, "")
  16.             Exit Sub
  17.         End If
  18.     '*********************************************
  19.         Application.DisplayAlerts = False
  20.         For Each Sh In Sheets
  21.             If Sh.Name <> DataSheet.Name Then Sh.Delete    '刪除不必要的工作
  22.         Next
  23.         For Each Symbol In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))  '股票的迴圈
  24.             StartDate = .[C1]                           '迴圈需重新回到原本的 StartDate日期
  25.             Set Sh = Sheets.Add(, Sheets(Sheets.Count)) '新增的工作表位於活頁簿最後面(Sheets.Count)
  26.             DataSheet.Activate
  27.             Do While DateSerial(Year(StartDate), Month(StartDate), 1) <= EndDate
  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                      'Web查詢
  31.                         .QueryTables.Add "URL;" & Qur, .[M1]            'Web查詢資料在M欄
  32.                     Else
  33.                         .QueryTables(1).Connection = "URL;" & Qur
  34.                     End If
  35.                     With .QueryTables(1)
  36.                         .WebFormatting = xlWebFormattingNone
  37.                         .WebSelectionType = xlSpecifiedTables
  38.                         .WebDisableDateRecognition = True
  39.                         .WebTables = "7,8"
  40.                         .Refresh BackgroundQuery:=False
  41.                          If Application.CountA(.ResultRange) > 1 Then
  42.                             AR = .ResultRange.Offset(4)
  43.                             If Application.CountA(.Parent.[a:a]) = 0 Then AR = .ResultRange.Offset(3)
  44.                             xR = Application.CountA(.Parent.[a:a]) + 1                         '.Parent :Web查詢的父層
  45.                             .Parent.Cells(xR, "A").Resize(UBound(AR, 1), UBound(AR, 2)) = AR   '資料複製到 新增工作表的A欄
  46.                         End If
  47.                     End With
  48.                     
  49.                 End With

  51.                 StartDate = DateAdd("m", 1, StartDate)   '日期 + 1個月
  52.             Loop
  53.             With Sh
  54.                 .Name = Symbol                                 '以股票命名
  55.                 '------------------------
  56.                 .Activate
  57.                 .Range("E3").Select
  58.                 ActiveCell.FormulaR1C1 = _
  59.                 "=IF(ISERROR(DATEVALUE(1911+MID(RC[-4],1,FIND(""/"",RC[-4])-1) & MID(RC[-4],FIND(""/"",RC[-4]),LEN(RC[-4])))),"""",DATEVALUE(1911+MID(RC[-4],1,FIND(""/"",RC[-4])-1) & MID(RC[-4],FIND(""/"",RC[-4]),LEN(RC[-4]))))"
  60.                 .Range("E3").Select
  61.                 Selection.Copy
  62.                 .Columns("E:E").Select
  63.                 ActiveSheet.Paste
  64.                 .Columns("E:E").Select
  65.                 Selection.NumberFormatLocal = "[$-404]e/m/d;@"
  66.                 '------------------------
  67.                 .QueryTables(1).ResultRange = ""               '清除Web查詢的資料
  68.                  .Names(.QueryTables(1).Name).Delete           'Web查詢的名稱
  69.             End With
  70.         Next
  71.     End With
  72.     Application.DisplayAlerts = True
  73. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 生氣，就是拿別人的過錯來懲罰自己。
123
返回列表 上一主題