Board logo

標題: [發問] 如何將每個時段內的指定數值抽出 [打印本頁]
作者: donod    時間: 2013-8-23 17:52     標題: 如何將每個時段內的指定數值抽出

如何利用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中的右邊例子)，謝謝!
[attach]15838[/attach]
作者: cdkee    時間: 2013-8-24 21:22

回復 1# donod
[attach]15842[/attach]
作者: donod    時間: 2013-8-25 22:22

回復 2# cdkee
謝謝大大! 仍然不成功!
作者: GBKEE    時間: 2013-8-26 18:17

回復 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    時間: 2013-8-26 18:33

回復 4# GBKEE
謝謝GBKEE版大!
這個可行了，仍然消化中。
作者: donod    時間: 2013-8-26 23:39

本帖最後由 donod 於 2013-8-26 23:41 編輯

回復 4# GBKEE
[attach]15861[/attach]
請教版大是那裡出了問題，令到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    時間: 2013-8-28 14:05

回復 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    時間: 2013-8-28 18:18

本帖最後由 donod 於 2013-8-28 18:20 編輯

回復 7# GBKEE
[attach]15870[/attach]
感謝版大教導!
但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    時間: 2013-9-1 11:56

本帖最後由 GBKEE 於 2013-9-1 12:15 編輯

回復 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    時間: 2013-9-2 11:47

回復 9# GBKEE
可以了，消化中，感謝GBKEE版大無私教導!謝謝!
作者: donod    時間: 2013-9-2 15:58

[attach]15919[/attach]
再請教如何將指定時段內的指定數值取代上一個/下一個時段內相關數值?之後重新排列(如Sheet1中的右邊例子)，再三謝謝!
指定時段:
9:14, 12:59, 16:59 這3個時段的"Open"數值取代下一個時段9:15, 13:00, 17:00的"Open"數值
16:15, 12:00, 23:00 這3個時段的"Close"數值取代上一個時段16:14, 11:59, 22:59的"Close"數值
作者: GBKEE    時間: 2013-9-2 18:22

回復 11# donod
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng(1 To 3) As Range, i  As Integer, Ar(), S
  4.     Set Rng(1) = Sheets("Sheet1").Range("b:b")
  5.     Ar = Array(#9:14:00 AM#, #12:59:00 PM#, #4:59:00 PM#, #4:15:00 PM#, #12:00:00 PM#, #11:00:00 PM#)
  6.     For i = 0 To UBound(Ar)
  7.         Set Rng(2) = Rng(1).Find(Ar(i), LookIn:=xlFormulas)
  8.         If Not Rng(2) Is Nothing Then
  9.             S = Rng(2).Address
  10.             Do
  11.                 If i <= Int(UBound(Ar) / 2) Then
  12.                     Rng(2).Offset(1, 1) = Rng(2).Offset(, 1)
  13.                 Else
  14.                     Rng(2).Offset(-1, 4) = Rng(2).Offset(, 4)
  15.                 End If
  16.                 If Not Rng(3) Is Nothing Then
  17.                     Set Rng(3) = Union(Rng(3), Rng(1).Parent.Range(Rng(1).Parent.Cells(Rng(2).Row, "a"), Rng(1).Parent.Cells(Rng(2).Row, "g")))
  18.                 Else
  19.                     Set Rng(3) = Rng(1).Parent.Range(Rng(1).Parent.Cells(Rng(2).Row, "a"), Rng(1).Parent.Cells(Rng(2).Row, "g"))
  20.                 End If
  21.                 Set Rng(2) = Rng(1).FindNext(Rng(2))
  22.             Loop Until S = Rng(2).Address
  23.         End If
  24.     Next
  25.      If Not Rng(3) Is Nothing Then Rng(3).Delete
  26. End Sub
複製代碼
作者: donod    時間: 2013-9-2 19:59

回復 12# GBKEE
要感謝的太多了!感謝GEKEE版大教導!
作者: donod    時間: 2013-9-5 12:59

再請教如何將B欄的時間自動增加1分鐘(e.g. 9:15轉為9:16)
之後在H欄顯示相關Date Code(e.g. 5130916 代表5月13日9:16)
謝謝!
[attach]15948[/attach]
作者: GBKEE    時間: 2013-9-5 14:00

回復 14# donod
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim D As Variant, E As Range
  4.     For Each E In Range("b2", [b2].End(xlDown))
  5.         D = Split(E.Offset(, -1), "/")
  6.         E.Value = E + #12:01:00 AM#
  7.         E.Offset(, 6) = D(0) & D(1) & Replace(E.Text, ":", "")
  8.     Next
  9. End Sub
複製代碼
還是
  1. Sub Ex1()
  2.     Dim D As Variant, E As Range, b As Date
  3.     For Each E In Range("b2", [b2].End(xlDown))
  4.         b = E + #12:01:00 AM#
  5.         D = Split(E.Offset(, -1), "/")
  6.         E.Offset(, 6) = D(0) & D(1) & Application.Text(b, "hhmm")
  7.     Next
  8. End Sub
複製代碼
作者: donod    時間: 2013-9-5 14:25

回復 15# GBKEE
跟從GBKEE版大的指導，成功了!再三感謝!
  1. Option Explicit

  3. Sub Ex()

  5.     Dim D As Variant, E As Range, b As Date

  7.     For Each E In Range("b2", [b2].End(xlDown))

  9.         D = Split(E.Offset(, -1), "/")
  10.         
  11.         b = E + #12:01:00 AM#

  13.         E.Value = E + #12:01:00 AM#

  15.         'E.Offset(, 6) = D(0) & D(1) & Replace(E.Text, ":", "")
  16.          E.Offset(, 6) = D(0) & D(1) & Application.Text(b, "hhmm")

  18.     Next

  20. End Sub
複製代碼
作者: donod    時間: 2013-9-5 15:13

請問如果要處理的檔案A.xls已經打開，以上的VBA檔案在B.xlsm，如何寫才能對A.xls作自動變動，謝謝!
作者: donod    時間: 2013-9-5 18:15

這個不行
  1. Sub Ex()



  5.     Dim D As Variant, E As Range, b As Date
  6.   
  7.     Windows("A.xls").Activate
  8.     Sheets("Sheet1").Select
  9.       
  10.     With ActiveWorkbook.Sheets(1)
  11.    
  12.    
  13.         For Each E In Range("b1", [b1].End(xlDown))

  15.           D = Split(E.Offset(, -1), "/")
  16.         
  17.           b = E + #12:01:00 AM#

  19.           E.Value = E + #12:01:00 AM#

  21.           E.Offset(, 6) = D(0) & D(1) & Application.Text(b, "hhmm")

  23.         Next
  24.    
  25.    
  26.     End With

  28. End Sub
複製代碼
[attach]15955[/attach]
作者: GBKEE    時間: 2013-9-5 20:18

回復 18# donod
  1. Option Explicit
  2. Sub Ex()
  3.     Dim D As Variant, E As Range, b As Date
  4.     With Workbooks("A.xls").Sheets("Sheet1")
  5.         For Each E In .Range("b2", .[b2].End(xlDown))
  6.             D = Split(E.Offset(, -1), "/")
  7.             b = E + #12:01:00 AM#
  8.             E.Value = E + #12:01:00 AM#
  9.             E.Offset(, 6) = D(0) & D(1) & Application.Text(b, "hhmm")
  10.         Next
  11.     End With
  12. End Sub
複製代碼
作者: donod    時間: 2013-9-5 23:25

回復 19# GBKEE
明白了，感謝GBKEE版大教導!
作者: handsometrowa    時間: 2013-9-12 14:04

回復 7# GBKEE


    G大，想請問您關於這邊陣列邏輯問題

Option Explicit
Sub Ex()
    Dim AR(),  這裡宣告一組陣列變數我了解   Rng As Range, i As Integer, A(1 To 6), T As Integer   
    ReDim AR(0)  為什麼這裡馬上就要重新定義陣列變數呢?   
                                                        而且我有一個疑問  AR(0) 是這個陣列元素中的第一個變數?  還是 重新宣告整個陣列變數
    With Sheets("Sheet1")
        .[B:B].Replace "000", "00", xlPart         '修改為時間格式 **********
        AR(0) = .[A1:F1]   

這是我第二個疑惑的點＠@"  重新把元素賦予給 AR(0)  這是什麼意思  
意思是   
AR(0) = A1  
AR(1)=B1
AR(2)=C1
AR(3)=D1
AR(4)=E1
AR(5)=F1   

OR  

AR(0) 裡面就含有  六個元素??    我覺得怪怪的 所以特此請教@@

以上謝謝~^^
作者: GBKEE    時間: 2013-9-12 14:51

回復 21# handsometrowa
Dim AR(),  這裡宣告一組陣列變數我了解                -> 瞭解它是動態陣列,空的陣列??
ReDim AR(0)  為什麼這裡馬上就要重新定義陣列變數呢?   ->新增一元素 (作為表頭用的)  
重新把元素賦予給 AR(0)  這是什麼意思                  -> 請按F8 逐行執行程式,過了行 AR(0) = .[A1:F1] 到[檢視]-[區域變數視窗] 看AR(0)的內容
例如  .[B5:F9] => 二維陣列( 1 To  9 - 4 , 1 To  5 [B欄 - F欄的 欄數] ) =>二維陣列( 列數 , 欗數 )



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)