[已解决]请教一段代码，好象难了点

zpcs32 · 发表于 2011-10-27 12:24

求一段羽毛球比赛随机抽签形成的对阵代码
要求1：同一学校的同学不对阵比赛
要求2：如果报名人数增加或减少，代码仍然可用。
详见附件，谢谢。

最佳答案

月排行榜 / 总排行榜

zjdh

2011-10-30 08:57

本帖最后由 zjdh 于 2011-10-30 09:28 编辑

不死循环的办法想出来了：

Sub TEST()
Dim ARR, BRR(), I%, T%, R%, N%, M%
Columns("C:D").ClearContents
ARR = Sheets(2).Range("A2:C" & Sheets(2).Range("A65536").End(3).Row)
N = UBound(ARR)
For I = 1 To N Step 2
T = T + 1
10 R = Int(Rnd() * N + 1)
If ARR(R, 3) <> "" Then GoTo 10
Cells(T * 3 + 2, 4) = ARR(R, 1)
Cells(T * 3 + 2, 3) = ARR(R, 2)
ARR(R, 3) = 1
20 R = Int(Rnd() * N + 1)
If (ARR(R, 3) <> "" Or ARR(R, 2) = Cells(T * 3 + 2, 3)) Then
M = M + 1
If M = 100 Then M = 0: TEST '超过100次死循环重来
GoTo 20
End If
M = 0
Cells(T * 3 + 3, 4) = ARR(R, 1)
Cells(T * 3 + 3, 3) = ARR(R, 2)
ARR(R, 3) = 1
Next
End Sub

复制代码

跳转到最佳答案楼层

zjdh · 发表于 2011-10-27 15:26

本帖最后由 zjdh 于 2011-10-27 15:33 编辑

你试试：

比赛抽签.rar (11.89 KB, 下载次数: 59)

爱疯 · 发表于 2011-10-27 16:26

这问题有代表性，来学习。

zjdh的，我连续点，到第7次时就死了，是我的问题么？

zpcs32 · 发表于 2011-10-27 19:14

回复 zjdh 的帖子

谢谢zjdh。不过3楼说的确实是个问题，点第7次时总死机，望新解。

zjdh · 发表于 2011-10-27 20:12

本帖最后由 zjdh 于 2011-10-27 22:05 编辑

果然如此，主要是最后一对出现随机数重复相同，无法获得最后一个序号，不知何故，现已作特殊处理。

比赛抽签2.rar (12.29 KB, 下载次数: 29)

zpcs32 · 发表于 2011-10-27 21:51

回复 zjdh 的帖子

再次感谢zjdh的指点，我对修改的代码进行测试，确实解决了死机的问题，但产生了新问题——多点几次按钮，就会出现同一个学校的学生出现在同一组对阵的情况。再请zjdh前辈再看看。
另外，ARR改成数组，会不会更好点？

zjdh · 发表于 2011-10-27 21:53

我再看看
ARR本来就是数组！

zjdh · 发表于 2011-10-27 22:05

确实还是最后一组，现已修改，5楼附件已更新！

zpcs32 · 发表于 2011-10-28 06:38

回复 zjdh 的帖子

再谢zjdh，让您费心了！
经您修改，确实短时间内不会再出现对阵冲突的现象。
由于这是抽签，我就做了一个循环，让数据一直在动，这样更形象一些。
但我发现，当TEST运行的次数很多时，又会出现死机，不知是由于出现了对阵冲突，还是我的循环本身有问题，再请您给诊断一下，谢谢。

数据滚动.rar (12.1 KB, 下载次数: 11)

zjdh · 发表于 2011-10-28 07:54

本帖最后由 zjdh 于 2011-10-28 07:56 编辑

循环没问题，那是出现了最后2组4人都是一个学校时，系统进入死循环。
因此得考虑另一种方法抽签了！

		自动登录	找回密码
密码			注册