- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
本帖最後由 GBKEE 於 2012-7-10 16:02 編輯
回復 4# jovi0801 - Sub Ex() 'DatePart("WW", .Rows(xi).Cells(1)) 傳回第幾週
- Dim AR, xi As Integer, xAr As Integer, Rng As Range
- With Sheets("日價格")
- AR = Application.Transpose(.Range("A1").CurrentRegion.Rows(1).Value) '取得欄位
- xAr = 2
- xi = 2
- ReDim Preserve AR(1 To 5, 1 To xAr) '新增一維空白陣列
- Set Rng = .Cells(xi, "A") '一週營業的第一天日期位置
- Do While .Cells(xi, "A") <> ""
- If DatePart("WW", .Cells(xi, "A")) <> DatePart("WW", .Cells(xi + 1, "A")) Then
- Set Rng = Range(Rng, .Cells(xi, "E")) '一週營業的第一天日期位置 到 最後第一天收盤價位置
- AR(1, xAr) = Rng.Cells(1) '日期 Rng.Cells(1) 日期: 週一 或 .Cells(xi, "A") 日期: 週五(最後一天)
- AR(2, xAr) = Rng.Cells(1, 2) '開盤價
- AR(3, xAr) = Application.Max(Rng.Columns(3)) '最高價
- AR(4, xAr) = Application.Min(Rng.Columns(4)) '最低價
- AR(5, xAr) = .Cells(xi, "E") '收盤價
- If .Cells(xi + 1, "A") <> "" Then
- Set Rng = .Cells(xi + 1, "a")
- xAr = xAr + 1
- ReDim Preserve AR(1 To 5, 1 To xAr)
- End If
- End If
- xi = xi + 1
- Loop
- End With
- With Sheets("周價格")
- .UsedRange.Clear
- .[A1].Resize(xAr, 5) = Application.Transpose(AR)
- End With
- End Sub
|
|
發表於 2012-7-9 17:02
| 
