[發問] 如何將每個時段內的指定數值抽出

donod

如何利用VBA，將每1分鐘的"OPEN""HIGH""LOW""CLOSE"數值(如Sheet1中的左邊例子)，轉為每15分鐘(9:15-9:29, 9:30-9:44, 9:45-9:59, 10:00-10:14,...等等)，其內(15分鐘)時段的第1個"OPEN"數值，最"HIGH"數值，最"LOW"數值及最後的1個"CLOSE"數值，將這些數值抽出來，重新排列(如Sheet1中的右邊例子)，謝謝!
15min.rar (53.96 KB)

下載次數: 8

2013-8-23 17:50

cdkee

回復 1# donod
test.rar (14.02 KB)

下載次數: 6

2013-8-24 21:18

donod

回復 2# cdkee
謝謝大大! 仍然不成功!

GBKEE

回復 3# donod

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim AR(), Rng As Range, i As Integer, A(1 To 6), T As Integer
   
4.     ReDim AR(0)
   
5.     With Sheets("Sheet1")
   
6.         AR(0) = .[A1:F1]
   
7.         Set Rng = .Range("b2")
   
8.         T = 14 - Abs(Minute(Rng) Mod 15)        '距下一個15分鐘的分鐘數
   
9.         i = 1
   
10.         Do
    
11.             If TimeValue(Rng.Offset(i)) > TimeValue(Rng) + TimeValue("00:" & T) Or Rng.Offset(i, -1) <> Rng.Offset(, -1) Or Rng.Offset(i) = "" Then          '
    
12.                 A(1) = Rng.Resize(i).Cells(1).Offset(, -1)         'Date
    
13.                 A(2) = Rng.Cells(1)                                'Time
    
14.                 A(3) = Rng.Cells(1, 2)                             'Open
    
15.                 A(4) = Application.Max(Rng.Resize(i).Offset(, 2))  'High
    
16.                 A(5) = Application.Min(Rng.Resize(i).Offset(, 3))  'Low
    
17.                 A(6) = Rng.Resize(i).Offset(, 4).Cells(i)          'Close
    
18.                 ReDim Preserve AR(UBound(AR) + 1)
    
19.                 AR(UBound(AR)) = A
    
20.                 Set Rng = Rng.Offset(i)
    
21.                 T = 14 - Abs(Minute(Rng) Mod 15)                    '距下一個15分鐘的分鐘數
    
22.                 i = 1
    
23.             Else
    
24.                 i = i + 1
    
25.             End If
    
26.         Loop Until Rng.Offset(i) = ""
    
27.         .[J1].CurrentRegion = ""
    
28.         .[J1].Resize(UBound(AR) + 1, 6) = Application.Transpose(Application.Transpose(AR))
    
29.     End With
    
30. End Sub

複製代碼

donod

回復 4# GBKEE
謝謝GBKEE版大!
這個可行了，仍然消化中。

donod

回復 4# GBKEE
B15min1.rar (754.08 KB)

下載次數: 4

2013-8-26 23:38

請教版大是那裡出了問題，令到13:00-13:14,13:45-13:59,14:30-14:44,15:15-15:29,16:00-1614這些時段只計算了14分鐘時段。
2/1/2013        13:00:000        23145        23152        23112        23130
2/1/2013        13:14:000        23128        23128        23126        23128
2/1/2013        13:15:000        23127        23140        23127        23128
2/1/2013        13:30:000        23129        23170        23129        23165
2/1/2013        13:45:000        23166        23193        23165        23187
2/1/2013        13:59:000        23187        23193        23184        23193
2/1/2013        14:00:000        23193        23204        23171        23180
2/1/2013        14:15:000        23181        23196        23173        23191
2/1/2013        14:30:000        23190        23216        23173        23189
2/1/2013        14:44:000        23190        23198        23190        2319
2/1/2013        14:45:000        23197        23224        23189        23214
2/1/2013        15:00:000        23214        23237        23200        23212
2/1/2013        15:15:000        23212        23230        23206        23229
2/1/2013        15:29:000        23230        23235        23229        23231
2/1/2013        15:30:000        23230        23300        23230        23300
2/1/2013        15:45:000        23298        23322        23288        23295
2/1/2013        16:00:000        23295        23300        23241        23244
2/1/2013        16:14:000        23244        23249        23222        23222

GBKEE

回復 6# donod

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim AR(), Rng As Range, i As Integer, A(1 To 6), T As Integer
   
4.     ReDim AR(0)
   
5.     With Sheets("Sheet1")
   
6.         .[B:B].Replace "000", "00", xlPart         '修改為時間格式 **********
   
7.         AR(0) = .[A1:F1]
   
8.         Set Rng = .Range("b2")
   
9.         T = 14 - Abs(Minute(Rng) Mod 15)        '距下一個15分鐘的分鐘數
   
10.         i = 1
    
11.         Do
    
12.            If Rng.Offset(i) > Rng + TimeValue("00:" & T) Or Rng.Offset(i, -1) <> Rng.Offset(, -1) Or Rng.Offset(i) = "" Then
    
13.                 A(1) = Rng.Resize(i).Cells(1).Offset(, -1)         'Date
    
14.                 A(2) = Rng.Cells(1).Text                               'Time
    
15.                 A(3) = Rng.Cells(1, 2)                             'Open
    
16.                 A(4) = Application.Max(Rng.Resize(i).Offset(, 2))  'High
    
17.                 A(5) = Application.Min(Rng.Resize(i).Offset(, 3))  'Low
    
18.                 A(6) = Rng.Resize(i).Offset(, 4).Cells(i)          'Close
    
19.                 ReDim Preserve AR(UBound(AR) + 1)
    
20.                 AR(UBound(AR)) = A
    
21.                 Set Rng = Rng.Offset(i)
    
22.                 T = 14 - Abs(Minute(Rng) Mod 15)                    '距下一個15分鐘的分鐘數
    
23.                 i = 1
    
24.             Else
    
25.                 i = i + 1
    
26.             End If
    
27.         Loop Until Rng.Offset(i) = ""
    
28.         .[J1].CurrentRegion = ""
    
29.         .[J1].Resize(UBound(AR) + 1, 6) = Application.Transpose(Application.Transpose(AR))
    
30.     End With
    
31. End Sub

複製代碼

donod

回復 7# GBKEE
B15min2.rar (778.96 KB)

下載次數: 4

2013-8-28 18:19

感謝版大教導!
但16:00-1614這個時段仍然只計算了14分鐘時段。

2/1/2013        15:15:00        23212        23235        23206        23231
2/1/2013        15:30:00        23230        23300        23230        23300
2/1/2013        15:45:00        23298        23322        23288        23295
2/1/2013        16:00:00        23295        23300        23241        23244
2/1/2013        16:14:00        23244        23249        23222        23222
2/1/2013        16:15:00        23226        23226        23226        23226
3/1/2013        9:14:00        23358        23358        23358        23358
3/1/2013        9:15:00        23358        23381        23309        23318

GBKEE

回復 8# donod

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim AR(), Rng As Range, i As Integer, A(1 To 6), T As Integer
   
4.     Dim RT(1 To 2) As Single                       '****指定變數型態
   
5.     ReDim AR(0)
   
6.     With Sheets("Sheet1")
   
7.         .[B:B].Replace "000", "00", xlPart         '修改為時間格式
   
8.         AR(0) = .[A1:F1]
   
9.         Set Rng = .Range("b2")
   
10.         T = 14 - Abs(Minute(Rng) Mod 15)        '距下一個15分鐘的分鐘數
    
11.         RT(1) = Rng + TimeValue("00:" & T)
    
12.         i = 1
    
13.         Do
    
14.             RT(2) = Rng.Offset(i)
    
15.             If RT(2) > RT(1) Or Rng.Offset(i, -1) <> Rng.Offset(, -1) Or Rng.Offset(i) = "" Then
    
16.                 A(1) = Rng.Resize(i).Cells(1).Offset(, -1)         'Date
    
17.                 A(2) = Rng.Cells(1).Text                               'Time
    
18.                 A(3) = Rng.Cells(1, 2)                             'Open
    
19.                 A(4) = Application.Max(Rng.Resize(i).Offset(, 2))  'High
    
20.                 A(5) = Application.Min(Rng.Resize(i).Offset(, 3))  'Low
    
21.                 A(6) = Rng.Resize(i).Offset(, 4).Cells(i)         'Close
    
22.                 ReDim Preserve AR(UBound(AR) + 1)
    
23.                 AR(UBound(AR)) = A
    
24.                 Set Rng = Rng.Offset(i)
    
25.                 T = 14 - Abs(Minute(Rng) Mod 15)                    '距下一個15分鐘的分鐘數
    
26.                 RT(1) = Rng + TimeValue("00:" & T)
    
27.                 i = 1
    
28.             Else
    
29.                 i = i + 1
    
30.             End If
    
31.         Loop Until Rng.Offset(i) = ""
    
32.         .[J1].CurrentRegion = ""
    
33.         .[J1].Resize(UBound(AR) + 1, 6) = Application.Transpose(Application.Transpose(AR))
    
34.     End With
    
35. End Sub

複製代碼

donod

回復 9# GBKEE
可以了，消化中，感謝GBKEE版大無私教導!謝謝!