Option Explicit
Sub abc()
Dim a, i, j, x, y, m
a = Range("g1:ao" & Cells(Rows.Count, "h").End(xlUp).Row).Value
If (UBound(a) - 2) Mod 10 Then MsgBox "每段数据为10行!": Exit Sub
ReDim b(1 To 10 ^ 5, 1 To 1) As String
For i = 2 To UBound(a, 2) Step 5
For j = i + 1 To i + 3
a(1, j) = a(1, i)
Next
Next
For i = 3 To UBound(a) Step 10
For j = 2 To UBound(a, 2) Step 5
For x = i To i + 8
For y = j To j + 3
If a(x, y) >= 15 Then
m = m + 1
b(m, 1) = a(i, 1) & "," & a(1, y) & "," & _
a(x, 1) & "," & a(2, y) & "," & a(i + 9, y)
End If
Next
Next
Next
Next
With [f:f]
.ClearContents
If m > 0 Then .Resize(m) = b
End With
End Sub