【求助】分组问题，大佬帮帮忙

可以，这样
【图片】

如果要随机分组的话，感觉很复杂，5个组各有多少人啊？

Option Explicit
Sub abc()
　Dim a, b, i, j, k, m, d, t
　b = [a1:a60].Value
　Set d = CreateObject("scripting.dictionary")
　ReDim a(1 To 5, 1 To 2)
　For i = 1 To 60
　　If Not d.exists(b(i, 1)) Then
　　　m = m + 1: d(b(i, 1)) = m
　　　a(m, 1) = b(i, 1)
　　End If
　　a(d(b(i, 1)), 2) = a(d(b(i, 1)), 2) + 1
　Next
　[c1].Resize(5, 2) = a
　ReDim b(1 To 30, 1 To 2)
　m = 0
　For i = 1 To 30
　　For j = 1 To 4
　　　For k = j + 1 To 5
　　　　If a(j, 2) < a(k, 2) Then
　　　　　t = a(j, 1): a(j, 1) = a(k, 1): a(k, 1) = t
　　　　　t = a(j, 2): a(j, 2) = a(k, 2): a(k, 2) = t
　　　　End If
　　　Next
　　Next
　　m = m + 1
　　b(m, 1) = a(1, 1): b(m, 2) = a(2, 1)
　　a(1, 2) = a(1, 2) - 1: a(2, 2) = a(2, 2) - 1
　Next
　[c1].Resize(30, 2) = b
End Sub