- 帖子
- 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來解決日轉週、轉月、轉季......轉檔問題- Sub 日線轉週線()
- '建立日期與年週對照字典檔
- Dim d
- Set d = CreateObject("Scripting.Dictionary")
- Dim c As Range
- For Each c In Sheets("日價格").Range("A2:A" & Sheets("日價格").[A2].End(xlDown).Row)
-
- '將日期轉為年週，例如201215表示2012年第15週
- yyyyww = Year(c.Value) & Format(DatePart("ww", c.Value), "00")
-
- '檢查年週是否在字典檔中，若不存在則加入
- If Not d.Exists(yyyyww) Then
- d.Add yyyyww, c.Value
- End If
- Next
- '刪除【周價格2】工作表暨存的資料
- With Sheets("周價格2")
- .[A1:E1].Value = Sheets("日價格").[A1:E1].Value
- .Activate
- .Rows("2:" & .[A2].End(xlDown).Row).ClearContents
- End With
-
- '建立ADODB Connection物件變數
- Dim cn As ADODB.Connection
- Set cn = New ADODB.Connection
-
- With cn
- .Provider = "MSDASQL"
- .ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _
- "DBQ=" & ThisWorkbook.FullName & ";"
- .Open
- End With
-
- 'SQL字串
- mySQL = "Select 年週,FIRST(開盤價), MAX(最高價), MIN(最低價), LAST(收盤價) From ((SELECT (YEAR(日期)& FORMAT(DATEPART('ww',日期),'00')) AS 年週, 開盤價, 最高價, 最低價, 收盤價 FROM [日價格$A:E] WHERE 日期 IS NOT NULL) tmpTable) GROUP BY 年週"
-
- Set rs = cn.Execute(mySQL)
- With Sheets("周價格2")
- .Activate
- .Range("A2").CopyFromRecordset rs
- End With
-
- '將年週轉為該週第一個交易日期
- For Each c In Sheets("周價格2").Range("A2:A" & Sheets("周價格2").[A2].End(xlDown).Row)
- c.Value = d.Item(c.Value)
- Next
-
- '關閉連線清除記憶體
- cn.Close
- Set cn = Nothing
-
- MsgBox "轉檔完成!"
- End Sub
|
|
