| ©«¤l5923 ¥DÃD13 ºëµØ1 ¿n¤À5986 ÂI¦W0  §@·~¨t²Îwin10 ³nÅ骩¥»Office 2010 ¾\ŪÅv150 ©Ê§O¨k ¨Ó¦Û¥xÆW°ò¶© µù¥U®É¶¡2010-5-1 ³Ì«áµn¿ý2022-1-23 
         
 | 
                
| ¥»©«³Ì«á¥Ñ GBKEE ©ó 2013-9-1 12:15 ½s¿è 
 ¦^´_ 8# donod
 ½Æ»s¥N½XOption Explicit
Sub Ex()
    Dim AR(), Rng As Range, i As Integer, A(1 To 6), T As Integer
    Dim RT(1 To 2) As Single                       '****«ü©wÅܼƫ¬ºA
    ReDim AR(0)
    With Sheets("Sheet1")
        .[B:B].Replace "000", "00", xlPart         'קאּ®É¶¡®æ¦¡
        AR(0) = .[A1:F1]
        Set Rng = .Range("b2")
        T = 14 - Abs(Minute(Rng) Mod 15)        '¶Z¤U¤@Ó15¤ÀÄÁªº¤ÀÄÁ¼Æ
        RT(1) = Rng + TimeValue("00:" & T)
        i = 1
        Do
            RT(2) = Rng.Offset(i)
            If RT(2) > RT(1) Or Rng.Offset(i, -1) <> Rng.Offset(, -1) Or Rng.Offset(i) = "" Then
                A(1) = Rng.Resize(i).Cells(1).Offset(, -1)         'Date
                A(2) = Rng.Cells(1).Text                               'Time
                A(3) = Rng.Cells(1, 2)                             'Open
                A(4) = Application.Max(Rng.Resize(i).Offset(, 2))  'High
                A(5) = Application.Min(Rng.Resize(i).Offset(, 3))  'Low
                A(6) = Rng.Resize(i).Offset(, 4).Cells(i)         'Close
                ReDim Preserve AR(UBound(AR) + 1)
                AR(UBound(AR)) = A
                Set Rng = Rng.Offset(i)
                T = 14 - Abs(Minute(Rng) Mod 15)                    '¶Z¤U¤@Ó15¤ÀÄÁªº¤ÀÄÁ¼Æ
                RT(1) = Rng + TimeValue("00:" & T)
                i = 1
            Else
                i = i + 1
            End If
        Loop Until Rng.Offset(i) = ""
        .[J1].CurrentRegion = ""
        .[J1].Resize(UBound(AR) + 1, 6) = Application.Transpose(Application.Transpose(AR))
    End With
End Sub
 | 
 |