Option Explicit
Sub abc()
Dim a, b, i, j, k, m, n, p
ReDim b(1 To Cells(Rows.Count, "a").End(xlUp).Row * 2, 1 To 2 * 5)
For i = 1 To Cells(Rows.Count, "a").End(xlUp).Row
If Cells(i, "a").Value = "分数" Then
a = Cells(i, "a").CurrentRegion.Value
If UBound(a, 2) > p Then p = UBound(a, 2)
m = m + 2: n = 0
b(m - 1, 1) = a(1, 1)
For j = 2 To UBound(a)
For k = 1 To UBound(a, 2) Step 2
If Len(a(j, k)) Then
n = n + 2
b(m, n - 1) = a(j, k): b(m, n) = a(j, k + 1)
If n = 10 Then n = 0: m = m + 1
End If
Next
Next
m = m + 3
End If
Next
[a2].Offset(, p + 1).Resize(m, 10) = b
End Sub