100M比赛按班级分组

zopey

Private Sub CommandButton1_Click()
Dim arr, k0
k0 = [f4].End(4).Row - 4
arr = [f5].Resize(k0, 2)
zc = Application.RoundUp(k0 / 5, 0)

Dim d As Object, d2 As Object
Set d = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
For i = 1 To k0
    d(arr(i, 1)) = d(arr(i, 1)) + 1
    d2(arr(i, 1) & "," & d(arr(i, 1))) = arr(i, 2)
Next

Dim brr()
ReDim brr(1 To 6 * 5, 1 To 2)

i = 0
For Each bj In d.keys
For k = 1 To d(bj)
    i = i + 1: If i = zc + 1 Then i = 1
haha:
    j = Int(Rnd() * 5) + 1
    If brr((i - 1) * 5 + j, 1) = "" Then
       brr((i - 1) * 5 + j, 1) = bj
       brr((i - 1) * 5 + j, 2) = d2(bj & "," & k)
    Else
       GoTo haha
    End If
Next
Next

[c5].Resize(6 * 5, 2) = brr
End Sub

运动会分组.rar (13.87 KB, 下载次数: 12)

2018-10-13 10:01 上传

点击文件名下载附件

zopey

一指禅62 发表于 2018-10-13 09:23
若只有5条跑道，某班有6人参加比赛，不同组次中道次不重复？

在极端情况下，某些预设条件 是无法满足的 。比如说 一个班30个人报名，把跑道都占完了，能不让参加吗？