データの既存のコードを抽出するvbaヘルプ

こんにちは、

既存のVBAコードを使用してデータをループし、特定のテキスト条件に基づいて列のデータを抽出する必要があります.

セルJ2から開始して抽出する必要があるフィールド:パーツ名、開始日、開始時間、終了日、終了時間、期間(分)(終了日/時間-開始日/時間)* 24* 60および日付.vbaはすべてのデータをループし、コピーして貼り付けます
列内.

プルする各新しいレコードは空白行で区切られます.複数の開始日と開始時刻がある場合があります.既存のコードで必要な助けは、レコードの各セットをループして、開始日と開始時間の最初の行を記録することです.
1つのレコード内.

これまでの私のVBAコード:

サブTEST()
Dim i、j As Integer
Dim Time1、Time2 As Long
Dim Date1、Date2 As Date
Dim Delta As Long
Worksheets( "Sheet1") .Activate
Time1 =＃1/1/2019＃
Time2 =＃1/1/2019＃
Date1 =＃1/1/2019＃
Date2 =＃1/1/2019＃
j=2
Range( "J2:N5000").Select
Selection.ClearContents
Range( "J2").Select
For i=2 To 5000
If ActiveSheet .Cells(i-1、2)= "" Then
ActiveSheet.Cells(j、10)= ActiveSheet.Cells(i、2)
End If
If ActiveSheet.Cells(i、1)="開始日" Then
If ActiveSheet.Cells(i、2)>Date1 Then
Else
ActiveSheet.Cells(j、11)= ActiveSheet.Cells(i、2)
End If
End If
If ActiveSheet.Cells(i、1)= "Measure Start Time" Then
If ActiveSheet.Cells(i、2)>Time1 Then
Else
ActiveSheet.Cells( j、12)= ActiveSheet.Cells(i、2)
End If
ElseIf ActiveSheet.Cells(i、1)= "Measure End Time" Then
ActiveSheet.Cells(j、14)= ActiveSheet .Cells(i、2).Value
End If
If ActiveSheet.Cells(i、1)= "End Date" Then
Ac tiveSheet.Cells(j、13)= ActiveSheet.Cells(i、2).Value
j=j + 1
Time1 =＃1/1/2019＃
Time2 =＃1/1/2019 ＃
End If
Next
End Sub

SAMPLE_DATA:

希望するサンプル結果:

移動元:Excel/Windows 10/Office 2016