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

zpcs32 · 发表于 2011-10-28 08:50

回复 zjdh 的帖子

我乃初学，又天生愚钝，急用却不得其解。还请前辈赐教！先谢为感！

吕?布 · 发表于 2011-10-28 17:09

留个记号

zpcs32 · 发表于 2011-10-29 19:13

本帖最后由 zpcs32 于 2011-10-29 19:16 编辑

回复吕?布的帖子

向战神致意，向zjdh致谢，再请两位看看九楼，可好？

吕?布 · 发表于 2011-10-29 19:32

我这几天在看这个，开始考虑先列出所有可能再随机选取，但感觉速度狂慢。当然如果能这样那是最好的
然后我想了其它的抽取方法，但是可能不够随机，现在我想到一个相对来讲较随机的并且一定有解的方法，但不确定能否成功

992582798 · 发表于 2011-10-29 19:39

在后面增加人员后，又会进入死循环，这是何原因呢

zpcs32 · 发表于 2011-10-29 20:03

回复吕?布的帖子

有您关注，此事必成。
我有一个想法，但因不太懂数组，所以不知怎么做，我的想法是这样的：
ARR这个数组中有姓名和学校两列内容，每当用随机函数提取ARR中的一个姓名、学校后，就从ARR中把这个被提取过的元素删除掉，这样，新的随机函数再想从ARR中提取元素时，就提不到已经被删除的元素了，也就不冲突了，您看这个想法是否有道理？
问题是：可不可以删除数组中的某个元素？
另外，我觉得应当把提取出来的元素先存放到别一个数组BRR中，提完后，再一次性写入单元格，这样就不用每提一个就写一次单元格，速度会不会快点儿？

20    R = Int(Rnd() * N + 1)
      If I = N - 1 Then
         For j = 1 To N
            If ARR(j, 3) = "" Then
               Cells(T * 3 + 3, 4) = ARR(j, 1) '从随机的角度来看，这里的j是不是也应当改成R更好？
                  Cells(T * 3 + 3, 3) = ARR(j, 2) '我试了一下，改了对运行没影响，但运行次数增多
                  GoTo 30
            End If
         Next
      End If
      If (ARR(R, 3) <> "" Or ARR(R, 2) = Cells(T * 3 + 2, 3)) Then GoTo 20   '死机都是因为这一句！！
      Cells(T * 3 + 3, 4) = ARR(R, 1)
      Cells(T * 3 + 3, 3) = ARR(R, 2)
      ARR(R, 3) = 1
Next

zjdh · 发表于 2011-10-30 08:56

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

1.
   If I = N - 1 Then
         For j = 1 To N
            If ARR(j, 3) = "" Then
               Cells(T * 3 + 3, 4) = ARR(j, 1) '
                  Cells(T * 3 + 3, 3) = ARR(j, 2)
                  GoTo 30
            End If
         Next
      End If
是用来处理最后一个被抽签者的，所以只要找出他直接赋值，而不用随机数R ，可以提高抽签速度！

2.  ARR(R, 3)是做记录用的只要被选用了，就将它赋值为1，下次查到它为1，则不再选用，而由随机数重选其他人。

3.  数组是不能删除一条记录的，只能将其内容清除，仍旧占用一个记录，只有用字典才能删除一条记录。

4.  出现死循环的原因是，最后的2位（我原程序已处理）、或4位（若一个学校的人数多的话可能6位、8位）未被随机数抽中时，他们都是同校学生而致。

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-30 09:03

若人数较多，应将那个100次适当加大，否则会使运算时间加长。

zpcs32 · 发表于 2011-10-30 09:34

本帖最后由 zpcs32 于 2011-10-30 09:50 编辑

回复 zjdh 的帖子

改过的代码确实很好，谢谢您!但结合9楼的附件尝试，虽不出现死循环，但也停不下来，这是为什么？

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

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

评分