看起来简单，实现起来却◎@#$%^&的一个问题： 大家不妨进来看看

Question

要实现的目标：6个队18个队员，组对厮杀，要求同队不比，任意两人只比一次，我建立一个数组来实现它，并用随机数模拟现实抽签，以下是代码：『简便起见，将各步骤分别处理，先不管效率：）』
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Private Sub Command1_Click()
    '使用二维数组进行对局随机产生，并写入数据库
    Dim Contest(1 To 54, 1 To 7) As Integer
    Dim m As Integer, n As Integer, k As Integer, No As Integer
    Dim Conflict As Boolean
    Dim A(1 To 18) As New Collection
    Conflict = False '初值
    '规则： 同队不比，已比不比，为了简化判断第一个规则，同队队员编号差6的倍数：
    '【1】数组清0
    '******************************************
    For m = 1 To 18
        For n = 1 To 7
            Contest(m, n) = 0
        Next n
    Next m
    
    '【2】应用规则
    '******************************************
    For i = 1 To 18
        For k = 1 To 18
            If (Abs(k - i)) Mod 6 <> 0 Then
            A(i).Add k, CStr(k)
            End If
        Next k
    Next i
    For m = 1 To 18
        For n = 1 To 7
            If Contest(m, n) = 0 Then
             'continue
            
               k = Rnd() * A(m).Count + 1
               No = A(m).Item(k)   '取得随机数，从当前行（者）集合中
               For i = 1 To n - 1
                          If Contest(m, i) = No Then
                             Conflict = True
                          Exit For
                          Else
                             Conflict = False
                          End If
               Next i
               If Contest(No, i) <> 0 Then Conflict = True
              
               Do While (Abs(No - m) Mod 6 = 0 Or Conflict)
                   If k = 0 Then k = k + 1
                   If k = A(m).Count Then k = k - 1
                   No = A(m).Item(k)
                                   
                   For i = 1 To n - 1
                          If Contest(m, i) = No Then
                             Conflict = True
                          Exit For
                          Else
                             Conflict = False
                          End If
                   Next i
                   If Contest(No, i) <> 0 Then Conflict = True
                   
               Loop
               
               Contest(m, n) = No
               Contest(No, n) = m  '确定相应数值，对手反向确定
               A(m).Remove CStr(No)
               A(No).Remove CStr(m)
               
              Debug.Print "contest[" & m & "," & n & "]="; Contest(m, n)
            End If
           
            DoEvents
        Next n
        DoEvents
    Next m
    MsgBox "完成对局安排"
    '【3】调试，显示结果
    '*********************************************
    For m = 1 To 18
        For n = 1 To 7
           Debug.Print "Contest[" & m & "," & n & "]=" & Contest(m, n)
        Next n
    Next m
End Sub＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
各位老大： 问题是这样的，在我机器上，程序算到contest(2,6)就没下文了：死翘翘了
也就是说，耗尽CPU资源。我很郁闷，来看看大家有没有甚么解决的方法，重新写也可以。
＝＝＝＝＝
再提一下，算法成功的话，对于一个18x7的二维数组，应该同列，同行均无重复数据，并且两两相应的。具体请看代码。这个事情，看起来真的不难,可是实现起来却很要命－－用随机数的坏处，就在这里巴？？
高手请指点。100分。

Answer 1

耗尽CPU资源-------->看完你的源码后,耗尽我资源 晕!

Answer 2

试下做成矩阵 第一队 A,B,C
第二队 D,E,F
第三队 G,H,I
第四队 J,K,L
第五队 M,N,O
第六队 P,Q,R

Answer 3

把你这帖子放到c/c++栏，发言的人肯定不少，但这儿都没讨论算法的热情。
这是真的！有时候我也喜欢看算法，但在用VB时不怎么去考虑的。

Answer 4

ecivilian(抽象青年) 老兄说得有理呵！

Answer 5

想了很多天，终于完成。回来时却不见了你的帖。。幸好有搜索功能。。
言归正传;
把你的问题抽象成以下模式：
六组队员，每组三个，依次为其编号，用逗号分隔不同的组得出一序列：
1 2 3，4 5 6，7 8 9，10 11 12，13 14 15，16 17 18
要求得出的结果就是：从上面的序列中得出9对元素不重复的结果，要求任何一对结果的两个数都不能落在上面那个序列的同一个区间（就是组），代码如下：Dim a(1 To 18), b(1 To 18) As Integer
Dim num As IntegerPrivate Sub Command1_Click()
Randomize
num = 1For i = 1 To 18
a(i) = i
NextFor i = 1 To 6
proc (i)
NextFor i = 1 To 4
    If a(i) Mod 3 = 1 And a(i + 2) - a(i) = 2 Then
        b(num) = a(i)
        num = num + 1
        a(7) = a(i + 1)
        a(8) = a(i + 2)        For l = i To 5
        a(l) = a(l + 3)
        Next        k = Int(3 * Rnd + 1)
        b(num) = a(k)
        num = num + 1
        For l = k To 4
        a(l) = a(l + 1)
        Next
        GoTo eight
    End If
Nextproc (7)eight:For i = 1 To 3
 If (a(i) Mod 3 = 1 And a(i + 1) - a(i) <= 2) Or (a(i) Mod 3 = 2 And a(i + 1) - a(i) = 1) Then
    b(num) = a(i)
    num = num + 1
    a(5) = a(i + 1)
    
    For l = i To 3
     a(l) = a(l + 2)
    Next
    
    k = Int(2 * Rnd + 1)
    b(num) = a(k)
    num = num + 1
    
    For l = k To 2
     a(l) = a(l + 1)
    Next
    GoTo last
 End If
Nextproc (8)last:b(17) = a(1)
b(18) = a(2)For i = 1 To 18 Step 2
Print b(i); ":"; b(i + 1); "       ";
Next
Print
End SubSub proc(j As Integer)
b(num) = a(1)
num = num + 1If a(1) Mod 3 = 1 And a(3) - a(1) = 2 Then
    k = Int(((17 - j * 2) * Rnd) + 4)
    b(num) = a(k)
    num = num + 1
    
    For l = k To 17
    a(l) = a(l + 1)
    Next
    
    For l = 1 To 17
    a(l) = a(l + 1)
    Next
    
    Exit Sub
End IfIf a(1) Mod 3 = 1 And a(2) - a(1) = 2 Then
    k = Int(((17 - j * 2) * Rnd) + 3)
    b(num) = a(k)
    num = num + 1
    
    For l = k To 17
    a(l) = a(l + 1)
    Next
    
    For l = 1 To 17
    a(l) = a(l + 1)
    Next
    
    Exit Sub
End If
If a(1) Mod 3 = 1 And a(2) - a(1) = 1 Then
    k = Int(((17 - j * 2) * Rnd) + 3)
    b(num) = a(k)
    num = num + 1
    
    For l = k To 17
    a(l) = a(l + 1)
    Next
    
    For l = 1 To 17
    a(l) = a(l + 1)
    Next
    
    Exit Sub
End IfIf a(1) Mod 3 = 2 And a(2) - a(1) = 1 Then
    k = Int(((17 - j * 2) * Rnd) + 3)
    b(num) = a(k)
    num = num + 1
    
    For l = k To 17
    a(l) = a(l + 1)
    Next
    
    For l = 1 To 17
    a(l) = a(l + 1)
    Next
    
    Exit Sub
End If
k = Int(((17 - j * 2) * Rnd) + 2)
    b(num) = a(k)
    num = num + 1
    
    For l = k To 17
    a(l) = a(l + 1)
    Next
    
    For l = 1 To 17
    a(l) = a(l + 1)
    NextEnd Sub

Answer 6

其实没有必要这么麻烦的：六组队员，每组三个，依次为其编号，用逗号分隔不同的组得出一序列：
1 2 3，4 5 6，7 8 9，10 11 12，13 14 15，16 17 18也就是每人比15场而已，Dim Num(0 To 17) As Long, No As Long, No2 As Long
Private Sub Form_Load()
    
    For No = 0 To 17
        Num(No) = No
    Next No
    
    For No = 0 To 16
        Print
        Print No; "Fight With "
        For No2 = No + 1 To 17
            
            If (No \ 3) <> (No2 \ 3) Then Print No2;'在此处理对局安排
        Next No2
    Next No
    '这样就可以完成对局安排End Sub

Answer 7

楼上的兄弟们，不知道你们算到了第几轮比赛，我在算到第六轮时也突然死翘翘了
lsftest() ：你的程序中对局记录保存在哪里，如果只是算一轮的话，那就不用说了：）