Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

工作中常用的Excel函数公式,全印在一张超大鼠标垫上
查看: 393|回复: 12

[已解决]求助大神,用vba实现新生招生报名摇号!

[复制链接]
发表于 2021-7-24 19:44 | 显示全部楼层 |阅读模式
本帖最后由 yangxibing 于 2021-7-24 19:47 编辑

求助大神,用vba实现新生招生报名摇号!根据学校学校位数,为新生随机安排学校,叩谢大神。
qq:624910936
微信:Y624910936
最佳答案
2021-7-25 19:21
yangxibing 发表于 2021-7-25 18:46
新想法:点击开始摇号时,屏幕连续变化(不间断),点击停止摇号,屏幕停止,为最终确定数据。

Dim gstop
Sub demo()
   Randomize
   a = Sheet3.UsedRange
   cnt = a(UBound(a), 2)
   ReDim s(1 To cnt), n(1 To cnt)
   For i = 2 To UBound(a) - 1
      For j = 1 To a(i, 2)
         c = c + 1: s(c) = a(i, 1): n(c) = c
      Next
   Next
   Sheet6.[a2:g1000].ClearContents
   b = Sheet4.Range("a2:g" & Sheet4.[a2].End(4).Row)
   cnt = Application.Min(cnt, UBound(b))
   gstop = 0
   Do While gstop = 0
      For i = 1 To cnt
         k = i + Int(Rnd * (cnt - i + 1))
         tmp = s(i): s(i) = s(k): s(k) = tmp
         tmp = n(i): n(i) = n(k): n(k) = tmp
         b(i, 6) = s(i): b(i, 7) = n(i)
      Next
      Sheet6.[a2].Resize(cnt, 7) = b
      DoEvents
   Loop
End Sub
Sub mystop()
   gstop = 1
End Sub

祝順心,南無阿彌陀佛!


招生报名摇号系统202107.rar

25.07 KB, 下载次数: 10

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2021-7-24 20:40 | 显示全部楼层
我看到学校的学位数有279个,而“摇号结果”表里的学生有304个,
所以我就设计成了双随机数。
但愿能帮到你:

Sub byWanao()
    Dim arr, brr, i%, j%, k%, endNum%, sNum%, pNum%
    Randomize
    Sheet6.Range("F2:F600").ClearContents   '先清空数据
    arr = Sheet3.UsedRange
    brr = Sheet6.UsedRange
    sNum = UBound(arr) - 2      '取学校总数
    pNum = UBound(brr) - 1      '取学生总数
    endNum = arr(UBound(arr), 2)
    If endNum > UBound(brr) Then endNum = UBound(brr)
    For i = 2 To endNum + 1
        Do
            j = Int(Rnd * sNum) + 1     '随机取一个学校
            If arr(j + 1, 2) <> 0 Then Exit Do
        Loop
        arr(j + 1, 2) = arr(j + 1, 2) - 1
        Do
            k = Int(Rnd * pNum) + 1     '随机取一个学生
            If brr(k + 1, 6) = "" Then Exit Do
        Loop
        brr(k + 1, 6) = arr(j + 1, 1)   '把学校赋值给学生
    Next
    Sheet6.Range("A1").Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub
回复

使用道具 举报

 楼主| 发表于 2021-7-25 11:08 | 显示全部楼层
wanao2008 发表于 2021-7-24 20:40
我看到学校的学位数有279个,而“摇号结果”表里的学生有304个,
所以我就设计成了双随机数。
但愿能帮到 ...

感谢您,已完美解决,我又增加了随机序号,现将附件上传,供有需要的下载。谢谢您!

招生报名摇号系统202107.rar

44.99 KB, 下载次数: 7

回复

使用道具 举报

发表于 2021-7-25 11:15 | 显示全部楼层
向大神学习!
回复

使用道具 举报

发表于 2021-7-25 15:27 | 显示全部楼层
Sub demo()
   Randomize
   a = Sheet3.UsedRange
   cnt = a(UBound(a), 2)
   ReDim s(1 To cnt), n(1 To cnt)
   For i = 2 To UBound(a) - 1
      For j = 1 To a(i, 2)
         c = c + 1: s(c) = a(i, 1): n(c) = c
      Next
   Next
   b = Sheet4.Range("a2:g" & Sheet4.[a2].End(4).Row)
   cnt = Application.Min(cnt, UBound(b))
   For i = 1 To cnt
      k = i + Int(Rnd * (cnt - i + 1))
      tmp = s(i): s(i) = s(k): s(k) = tmp
      tmp = n(i): n(i) = n(k): n(k) = tmp
      b(i, 6) = s(i): b(i, 7) = n(i)
   Next
   Sheet6.[a2:g1000].ClearContents
   Sheet6.[a2].Resize(cnt, 7) = b
End Sub

祝順心,南無阿彌陀佛!

招生报名摇号系统202107.rar

43.51 KB, 下载次数: 3

回复

使用道具 举报

 楼主| 发表于 2021-7-25 18:46 | 显示全部楼层
新想法:点击开始摇号时,屏幕连续变化(不间断),点击停止摇号,屏幕停止,为最终确定数据。

招生报名摇号系统202107(设置开始和结束).rar

44.61 KB, 下载次数: 1

回复

使用道具 举报

发表于 2021-7-25 19:21 | 显示全部楼层    本楼为最佳答案   
yangxibing 发表于 2021-7-25 18:46
新想法:点击开始摇号时,屏幕连续变化(不间断),点击停止摇号,屏幕停止,为最终确定数据。

Dim gstop
Sub demo()
   Randomize
   a = Sheet3.UsedRange
   cnt = a(UBound(a), 2)
   ReDim s(1 To cnt), n(1 To cnt)
   For i = 2 To UBound(a) - 1
      For j = 1 To a(i, 2)
         c = c + 1: s(c) = a(i, 1): n(c) = c
      Next
   Next
   Sheet6.[a2:g1000].ClearContents
   b = Sheet4.Range("a2:g" & Sheet4.[a2].End(4).Row)
   cnt = Application.Min(cnt, UBound(b))
   gstop = 0
   Do While gstop = 0
      For i = 1 To cnt
         k = i + Int(Rnd * (cnt - i + 1))
         tmp = s(i): s(i) = s(k): s(k) = tmp
         tmp = n(i): n(i) = n(k): n(k) = tmp
         b(i, 6) = s(i): b(i, 7) = n(i)
      Next
      Sheet6.[a2].Resize(cnt, 7) = b
      DoEvents
   Loop
End Sub
Sub mystop()
   gstop = 1
End Sub

祝順心,南無阿彌陀佛!


招生报名摇号系统202107(设置开始和结束).rar

43.96 KB, 下载次数: 6

回复

使用道具 举报

 楼主| 发表于 2021-7-25 19:31 | 显示全部楼层
cutecpu 发表于 2021-7-25 19:21
Dim gstop
Sub demo()
   Randomize

谢谢谢谢!太感谢了!

评分

参与人数 1学分 +2 收起 理由
cutecpu + 2 不客气。祝顺心,南无阿弥陀佛!

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2021-7-25 21:09 | 显示全部楼层
还想麻烦您看看,能不能在左边的册子里,实现右边这样的效果。摇号时所有的信息都滚动,排除家长认为随机安排的学校是摇号人员提前安排好的(有的家长会有这种想法)。
能实现右边这样的效果的话,随机序号这一列就可以取了。
当时加随机序号这一列的想法是,随机序号后,对参加摇号的学生重新排序(主要目的是打乱顺序),再随机配位学校。

招生报名摇号系统202107(03版).rar

58.78 KB, 下载次数: 5

回复

使用道具 举报

发表于 2021-7-25 22:31 | 显示全部楼层
yangxibing 发表于 2021-7-25 21:09
还想麻烦您看看,能不能在左边的册子里,实现右边这样的效果。摇号时所有的信息都滚动,排除家长认为随机安 ...

Dim gstop
Sub demo()
   Randomize
   a = Sheet3.UsedRange
   cnt = a(UBound(a), 2)
   ReDim s(1 To cnt), n(1 To cnt)
   For i = 2 To UBound(a) - 1
      For j = 1 To a(i, 2)
         c = c + 1: s(c) = a(i, 1): n(c) = c
      Next
   Next
   Sheet6.[a2:g1000].ClearContents
   b = Sheet4.Range("a2:g" & Sheet4.[a2].End(4).Row)
   cnt = Application.Min(cnt, UBound(b))
   ReDim bb(1 To cnt, 1 To 7)
   gstop = 0
   Do While gstop = 0
      For i = 1 To cnt
         k = i + Int(Rnd * (cnt - i + 1))
         kk = i + Int(Rnd * (cnt - i + 1))
         tmp = s(i): s(i) = s(k): s(k) = tmp
         tmp = n(i): n(i) = n(kk): n(kk) = tmp
         bb(i, 6) = s(i): bb(i, 7) = n(i)
         For j = 1 To 5
            bb(i, j) = b(n(i), j)
         Next
      Next
      Sheet6.[a2].Resize(cnt, 7) = bb
      DoEvents
   Loop
End Sub
Sub mystop()
   gstop = 1
End Sub

祝順心,南無阿彌陀佛!




demo.rar

45.11 KB, 下载次数: 5

评分

参与人数 1学分 +2 收起 理由
yangxibing + 2

查看全部评分

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2021-9-16 18:40 , Processed in 0.811156 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表