Option Explicit
Sub abc()
Dim a, i, j, m, n
a = [a1].CurrentRegion.Offset(1).Resize(, 5).Value
ReDim b(UBound(a), 9 + 1)
For i = 1 To UBound(a) - 1
n = n + 1: b(m + 1, n) = a(i, 1)
If n = 9 Then
b(m + 1, 10) = a(i, 5): b(m + 1, 0) = m + 1
m = m + 1: n = 0
End If
If a(i, 5) <> a(i + 1, 5) Then
If n > 0 Then
b(m + 1, 10) = a(i, 5): b(m + 1, 0) = m + 1
For j = n + 1 To 9: b(m + 1, j) = "/": Next
m = m + 1: n = 0
End If
End If
Next
b(0, 0) = "序号": b(0, 10) = "日期"
For i = 1 To 9: b(0, i) = i: Next
[q:q].NumberFormatLocal = "yyyy年mm月dd日"
[g1].Resize(m + 2, UBound(b, 2) + 1) = b
End Sub