这个不重复抽奖小程序能用VBA实现吗？

cjc209

lizhipei78 发表于 2023-3-12 16:15
实际生活中应该是这样子的

这就对了                  

lizhipei78

cjc209 发表于 2023-3-12 16:10
你说可以就可以 又不是我要

我也是小白，刚学VBA不久，好多不懂得，大神看到不对的地方就多指出来，万分感谢。

lizhipei78

佛山小老鼠 发表于 2023-3-12 15:34
我也写了一个，今天闲着着没事

大神，是不是搞得有点复杂了，我觉得把他的人员作一次随机排序就好了，然后就按这个随机排序好的人员按顺序来上台演讲不就好了，本来他给的人员也没有重复，不需要用到字典来去重

micch

1. Dim Code As Long ''' 设置一个登台顺序的记录，可有可无
   
2. Sub Start()
   
3.     ''' 开始先设置所有人都是待选状态，大于0小于1标记
   
4.     With Sheet1
   
5.         r = .Cells(65536, 1).End(3).Row
   
6.         ar = .Range("a2:a" & r).Value
   
7.         .Range("d2:d" & r).Value = ar
   
8.         .Range("e2:e" & r).Formula = "=rand()"
   
9.     End With
   
10.     Code = 0
    
11. End Sub
    
12. Sub RandSelect()
    
13.     ''' 人员通过随机数打乱，实现随机抽取
    
14.     ''' 每次抽取完，登台的设置大于1，下次登台设置为0
    
15.     ''' 保证每次随机都会从剩下的人抽取
    
16.     With Sheet1
    
17.         If .Range("e3").Value >= 1 Then
    
18.             ''' 加一个判断提示已经抽取完毕
    
19.             MsgBox "全部登台讲演完毕，没有预讲演人员"
    
20.         Else
    
21.             ''' 抽取讲演人员，设置预备讲演人员
    
22.             .Range("D:E").Sort .Range("e1"), xlAscending, , , , , , xlYes
    
23.             Code = Code + 1
    
24.             .Range("e2").Value = Code
    
25.             If .Range("e3").Value < 1 Then .Range("e3").Value = -1
    
26.         End If
    
27.     End With
    
28. End Sub

复制代码

micch

micch

micch 发表于 2023-3-12 22:43

其实简单几行代码就够了

1. Sub RandSelect1()
   
2.     With Sheet1
   
3.             .Range("D:E").Sort .Range("e1"), xlAscending, , , , , , xlYes
   
4.             .Range("e2").Value = 1
   
5.             If .Range("e3").Value < 1 Then .Range("e3").Value = -1
   
6.     End With
   
7. End Sub

复制代码