![](http://tiebapic.baidu.com/forum/w%3D580/sign=66ee0eb73df0f736d8fe4c093a54b382/123035fae6cd7b8953db024b4a2442a7d8330e7e.jpg?tbpicau=2024-06-27-05_26110e72bab9f1e9ba22f8509ed6565b)
Option Explicit
Sub abc()
Dim a, b, i, j, p
a = [a1].CurrentRegion.Offset(1).Resize(, 1).Value
b = Range("g5:j" & [f5].End(xlDown).Row).Value
ReDim c(1 To UBound(a) - 1, 1 To 1)
ReDim n(UBound(b))
For i = 1 To UBound(a) - 1
p = (a(i, 1) \ 10) + 1
If p <= UBound(n) Then
n(p) = n(p) + 1
c(i, 1) = b(p, n(p))
If n(p) = UBound(b, 2) Then n(p) = 0
End If
Next
[b2].Resize(UBound(c)) = c
End Sub