Hsieh

¦^´_ 1# cdkee
¸ê®ÆÂл\

1. Sub Ex()
   
2. Dim A As Range, Rng As Range, Ar(), t As Date
   
3. fs = ThisWorkbook.Path & "\TEST.xlsx" '­n³B²zªºÀÉ®×
   
4. With Workbooks.Open(fs)
   
5. With .Sheets(1)
   
6. For Each A In .Range(.[B1], .[B1].End(xlDown))
   
7. If Format(A, "hh:mm:ss") = "09:16:00" Or Format(A, "hh:mm:ss") = "13:31:00" Then
   
8. k = A.Offset(, 1): t = CDate(Format(A, "hh:mm:ss")) - TimeValue("00:02:00")
   
9.    For i = 1 To 2
   
10.        ReDim Preserve Ar(s)
    
11.        X = Format(t, "h:mm:ss0")
    
12.        Ar(s) = Array(A.Offset(, -1), X, k, k, k, k, "")
    
13.        s = s + 1
    
14.     t = t + TimeValue("00:01:00")
    
15.   Next
    
16. End If
    
17.    ReDim Preserve Ar(s)
    
18.    Ar(s) = Array(A.Offset(, -1).Value, A.Value, A.Offset(, 1).Value, A.Offset(, 2).Value, A.Offset(, 3).Value, A.Offset(, 4).Value, A.Offset(, 5).Value)
    
19.    s = s + 1
    
20. 
    
21. Next
    
22. .[A1].Resize(s, 7) = Application.Transpose(Application.Transpose(Ar))
    
23. End With
    
24. .Save '¦sÀÉ
    
25. End With
    
26. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 7# cdkee
¤@¼ÓªºÀ£ÁYÀɦ³2­ÓEXCELÀɮסA§Ú¦b·Q§A¬O­n¥HTEST.xlsm¤¤ªº¥¨¶°¨Ó¶}±ÒTEST.xlsxÀÉ®×
µM«á­×§ïTEST.xlsxªº¤º®e¡A©Ò¥H¥[¤W¤F¶}±ÒÀɮתº°Ê§@
¦pªG§Aªºµ{¦¡½X©ñ¦bTEST.xlsxªº¥ô¦ó¼Ò²Õ¤º¡A³£¤@¼Ë³y¦¨­«½Æ¶}±ÒÀɮתº¿ù»~