364

view

標準モジュールです
該当シートをアクティブにしてマクロを実行してください
F1 にグループ１
K1 にグループ２・・・となります
シートごとに分けて抽出がよければ、補足してください

-------------------------------------------------------------------
Sub test()

Dim sh As Worksheet
Dim i As Long
Dim ii As Long
Dim iii As Long
Dim cnt As Long
Dim lastrow As Long
Dim boo As Boolean

Set sh = ActiveSheet
With sh

lastrow = .Range("A1").End(xlDown).Row
i = 1
ii = 6
iii = 2
cnt = 1

Do Until i > lastrow
boo = True
.Cells(1, ii) = "グループ" & cnt
Do While boo = True
If i > lastrow Or .Cells(i + 1, 1) - .Cells(i, 1) > 50 Then
.Cells(iii, ii).Resize(, 3) = .Cells(i, 1).Resize(, 3).Value
i = i + 1
boo = False
Else
.Cells(iii, ii).Resize(, 3) = .Cells(i, 1).Resize(, 3).Value
i = i + 1
iii = iii + 1
End If
Loop
ii = ii + 5
iii = 2
cnt = cnt + 1
Loop
End With

End Sub
-------------------------------------------------------------------