12
返回列表 上一主題 發帖

[發問] 請問日價格怎麼轉變成週價格呢?

jovi0801

帖子
12 
主題
4 
精華
0 
積分
54 
點名
0  
作業系統
XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2012-6-13 
最後登錄
2020-9-1 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2012-7-8 23:26 | 只看該作者

[發問] 請問日價格怎麼轉變成週價格呢?

不知道這能用公式解決嗎?還是要寫程式碼才能完成呢?

Book.rar (9.16 KB)

收藏 分享

diabo

帖子
79 
主題
2 
精華
0 
積分
193 
點名
0  
作業系統
Winwos 7 64 bits 
軟體版本
Excel 2003/2007 
閱讀權限
20 
性別
男 
來自
TAIPEI 
註冊時間
2010-8-25 
最後登錄
2019-9-20 
13#
發表於 2012-7-13 22:02 | 只看該作者
工具→設定引用項目→Microsoft ActiveX Data Objects 2.8 Library

用 SQL來解決日轉週、轉月、轉季......轉檔問題
  1. Sub 日線轉週線()

  3.    '建立日期與年週對照字典檔
  4.     Dim d
  5.     Set d = CreateObject("Scripting.Dictionary")
  6.     Dim c As Range
  7.     For Each c In Sheets("日價格").Range("A2:A" & Sheets("日價格").[A2].End(xlDown).Row)
  8.    
  9.        '將日期轉為年週，例如201215表示2012年第15週
  10.         yyyyww = Year(c.Value) & Format(DatePart("ww", c.Value), "00")
  11.         
  12.        '檢查年週是否在字典檔中，若不存在則加入
  13.         If Not d.Exists(yyyyww) Then
  14.             d.Add yyyyww, c.Value
  15.         End If
  16.     Next

  18.    '刪除【周價格2】工作表暨存的資料
  19.     With Sheets("周價格2")
  20.         .[A1:E1].Value = Sheets("日價格").[A1:E1].Value
  21.         .Activate
  22.         .Rows("2:" & .[A2].End(xlDown).Row).ClearContents
  23.     End With
  24.    
  25.    '建立ADODB Connection物件變數
  26.     Dim cn As ADODB.Connection
  27.     Set cn = New ADODB.Connection
  28.    
  29.     With cn
  30.         .Provider = "MSDASQL"
  31.         .ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _
  32.          "DBQ=" & ThisWorkbook.FullName & ";"
  33.         .Open
  34.     End With
  35.    
  36.    'SQL字串
  37.     mySQL = "Select 年週,FIRST(開盤價), MAX(最高價), MIN(最低價), LAST(收盤價) From ((SELECT (YEAR(日期)& FORMAT(DATEPART('ww',日期),'00')) AS 年週, 開盤價, 最高價, 最低價, 收盤價 FROM [日價格$A:E] WHERE 日期 IS NOT NULL) tmpTable) GROUP BY 年週"
  38.    
  39.     Set rs = cn.Execute(mySQL)

  41.     With Sheets("周價格2")
  42.         .Activate
  43.         .Range("A2").CopyFromRecordset rs
  44.     End With
  45.    
  46.    '將年週轉為該週第一個交易日期
  47.     For Each c In Sheets("周價格2").Range("A2:A" & Sheets("周價格2").[A2].End(xlDown).Row)
  48.         c.Value = d.Item(c.Value)
  49.     Next
  50.    
  51.    '關閉連線清除記憶體
  52.     cn.Close
  53.     Set cn = Nothing
  54.    
  55.     MsgBox "轉檔完成!"

  57. End Sub
複製代碼
diabo

TOP

jovi0801

帖子
12 
主題
4 
精華
0 
積分
54 
點名
0  
作業系統
XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2012-6-13 
最後登錄
2020-9-1 
12#
發表於 2012-7-13 11:30 | 只看該作者
回復 11# c_c_lai
回復 10# GBKEE
沒有想到有新的版本出現,雖然我無法看到長什麼樣子也謝謝兩位的加強

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
11#
發表於 2012-7-12 14:28 | 只看該作者
回復 10# GBKEE
謝謝指導！
目前我對於 Set Rng 的應用尚未十分孰悉，可能是以往沒接觸過Excel
的緣故。 我會再加強這方面的應用， 謝謝您！

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-7-12 14:11 | 只看該作者
回復 9# c_c_lai
加上期間這不錯啊 ,但可不需新增變數來顯示.   
AR(6, xAr) = scope & "-" & .Cells(xi, "A")   ->      AR(6, xAr) = Rng.Cells(1) & "-" & .Cells(xi, "A")

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
9#
發表於 2012-7-12 08:30 | 只看該作者
回復 5# GBKEE
回復 8# jovi0801
我加上了一欄 "期間" (scope) 如此可以清楚地看出它們的歸屬。
純參考，希望 GBKEE 大大莫介意。
  1. Sub Ex()                           ' DatePart("WW", .Rows(xi).Cells(1))  傳回第幾週
  2.     Dim AR, xi As Integer, xAr As Integer, Rng As Range, scope As String
  3.    
  4.     With Sheets("日價格")
  5.         AR = Application.Transpose(.Range("A1").CurrentRegion.Rows(1).Value)     ' 取得欄位
  6.         xAr = 2
  7.         xi = 2
  8.         ReDim Preserve AR(1 To 6, 1 To xAr)                      ' 新增一維空白陣列
  9.         
  10.         Set Rng = .Cells(xi, "A")                                ' 一週營業的第一天日期位置
  11.         scope = .Cells(xi, "A")
  12.         
  13.         Do While .Cells(xi, "A") <> ""
  14.             If DatePart("WW", .Cells(xi, "A")) <> DatePart("WW", .Cells(xi + 1, "A")) Then
  15.                 Set Rng = Range(Rng, .Cells(xi, "E"))            ' 一週營業的第一天日期位置  到  最後第一天收盤價位置
  16.                 AR(1, xAr) = Rng.Cells(1)           ' 日期  Rng.Cells(1) 日期: 週一  或 .Cells(xi, "A") 日期: 週五(最後一天)
  17.                 AR(2, xAr) = Rng.Cells(1, 2)                     ' 開盤價
  18.                 AR(3, xAr) = Application.Max(Rng.Columns(3))     ' 最高價
  19.                 AR(4, xAr) = Application.Min(Rng.Columns(4))     ' 最低價
  20.                 AR(5, xAr) = .Cells(xi, "E")                     ' 收盤價
  21.                 AR(6, xAr) = scope & "-" & .Cells(xi, "A")
  22.                
  23.                 If .Cells(xi + 1, "A") <> "" Then
  24.                     Set Rng = .Cells(xi + 1, "A")
  25.                     xAr = xAr + 1
  26.                     scope = .Cells(xi + 1, "A")
  27.                     ReDim Preserve AR(1 To 6, 1 To xAr)
  28.                 End If
  29.             End If
  30.             xi = xi + 1
  31.         Loop
  32.     End With
  33.    
  34.     With Sheets("周價格")
  35.         .UsedRange.Clear
  36.         .[A1].Resize(xAr, 6) = Application.Transpose(AR)
  37.     End With
  38. End Sub
複製代碼
日價格怎麼轉變成週價格.rar (9.85 KB)

TOP

jovi0801

帖子
12 
主題
4 
精華
0 
積分
54 
點名
0  
作業系統
XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2012-6-13 
最後登錄
2020-9-1 
8#
發表於 2012-7-10 23:51 | 只看該作者
回復 6# Hsieh
謝謝Hsieh超級版主的提醒,但套用您的程式碼,會出現物件不支援此屬性或方法的訊息,而GBKEE版主所寫的程式碼,好像能達到您所說的效果,如附件 Book.rar (10.13 KB)

TOP

jovi0801

帖子
12 
主題
4 
精華
0 
積分
54 
點名
0  
作業系統
XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2012-6-13 
最後登錄
2020-9-1 
7#
發表於 2012-7-10 23:23 | 只看該作者
回復 5# GBKEE
再次感謝GBKEE版主的協助,解決我的問題

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
186  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-8-21 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 2012-7-10 18:38 | 只看該作者
回復 4# jovi0801
如果這是交易紀錄，不應該判斷周一與周五為區間
因為有可能遇到假日休市，以周別判定不知是否比較正確?
  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. Set d1 = CreateObject("Scripting.Dictionary")
  4. With Sheet1
  5. d1(1) = Array(.[A1].Value, .[B1].Value, .[C1].Value, .[d1].Value, .[E1].Value)
  6. For Each a In .Range(.[A2], .[A2].End(xlDown))
  7. w = Year(a) & ":" & Application.WorksheetFunction.WeekNum(a)
  8. If IsEmpty(d(w & "開")) Then d(w & "開") = a.Offset(, 1).Value
  9. If a.Offset(, 2) > d(w & "高") Then d(w & "高") = a.Offset(, 2).Value
  10. If IsEmpty(d(w & "低")) Then
  11. d(w & "低") = a.Offset(, 3).Value
  12. ElseIf d(w & "低") > a.Offset(, 3) Then
  13. d(w & "低") = a.Offset(, 3).Value
  14. End If
  15. d(w & "收") = a.Offset(, 4).Value
  16. d1(w) = Array(a.Value, d(w & "開"), d(w & "高"), d(w & "低"), d(w & "收"))
  17. Next
  18. End With
  19. With Sheet2
  20. .Cells = ""
  21. .[A1].Resize(d1.Count, 5) = Application.Transpose(Application.Transpose(d1.items))
  22. End With
  23. 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兔年全勤獎章
5#
發表於 2012-7-10 15:58 | 只看該作者
本帖最後由 GBKEE 於 2012-7-10 16:02 編輯

回復 4# jovi0801
  1. Sub Ex() 'DatePart("WW", .Rows(xi).Cells(1))  傳回第幾週
  2.     Dim AR, xi As Integer, xAr As Integer, Rng As Range
  3.     With Sheets("日價格")
  4.         AR = Application.Transpose(.Range("A1").CurrentRegion.Rows(1).Value)         '取得欄位
  5.         xAr = 2
  6.         xi = 2
  7.         ReDim Preserve AR(1 To 5, 1 To xAr)                             '新增一維空白陣列
  8.         Set Rng = .Cells(xi, "A")                                       '一週營業的第一天日期位置
  9.         Do While .Cells(xi, "A") <> ""
  10.             If DatePart("WW", .Cells(xi, "A")) <> DatePart("WW", .Cells(xi + 1, "A")) Then
  11.                 Set Rng = Range(Rng, .Cells(xi, "E"))                   '一週營業的第一天日期位置  到  最後第一天收盤價位置
  12.                 AR(1, xAr) = Rng.Cells(1)                               '日期  Rng.Cells(1) 日期: 週一  或 .Cells(xi, "A") 日期: 週五(最後一天)
  13.                 AR(2, xAr) = Rng.Cells(1, 2)                            '開盤價
  14.                 AR(3, xAr) = Application.Max(Rng.Columns(3))            '最高價
  15.                 AR(4, xAr) = Application.Min(Rng.Columns(4))             '最低價
  16.                 AR(5, xAr) = .Cells(xi, "E")                            '收盤價
  17.                 If .Cells(xi + 1, "A") <> "" Then
  18.                     Set Rng = .Cells(xi + 1, "a")
  19.                     xAr = xAr + 1
  20.                     ReDim Preserve AR(1 To 5, 1 To xAr)
  21.                 End If
  22.             End If
  23.             xi = xi + 1
  24.         Loop
  25.     End With
  26.     With Sheets("周價格")
  27.         .UsedRange.Clear
  28.         .[A1].Resize(xAr, 5) = Application.Transpose(AR)
  29.     End With
  30. End Sub
複製代碼

TOP

        靜思自在 : 信心、毅力、勇氣三者具備，則天下沒有做不成的事。
12
返回列表 上一主題