Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2808|回复: 9

[已解决]求大神帮忙:学生考试随机混排场

[复制链接]
发表于 2014-12-16 08:08 | 显示全部楼层 |阅读模式
学生考试随机混排考场(不按成绩),每场30人,考试号301260001-301262000,要求同班学生不出现连号。
原始数据(部分):
学号
总分
班级
考场
23325
549.5
33
01
23737
512.5
37
01
21145
488
11
01
24013
604
40
01
20953
576
9
01
21048
470
10
01
23925
496.5
39
01
21745
534
17
01
21925
557
19
01
23153
571
31
01
23102
688
31
01
23735
540
37
01
21738
543.5
17
01
21718
522.5
17
01
21952
415.5
19
01
23147
540.5
31
01
23911
472
39
01
21001
570.5
10
01
21324
551.5
13
01
23948
395.5
39
01
21331
550.5
13
01
24031
507
40
01
21911
567
19
01
23721
450.5
37
01
23256
404.5
32
01
20950
577
9
01
21019
569.5
10
01
23157
445
31
01
23954
442.5
39
01
21744
513.5
17
01
21327
538
13
02
24040
509.5
40
02
23355
501.5
33
02
23335
511.5
33
02
21521
543
15
02
23213
503.5
32
02
21901
599.5
19
02
23927
525.5
39
02
23536
418.5
35
02
23118
603
31
02
23930
574.5
39
02
23724
574.5
37
02
21949
541
19
02
23544
505
35
02
21333
593.5
13
02
21344
460
13
02
21907
604.5
19
02
23247
475
32
02
21036
502
10
02
23534
544
35
02
21023
617
10
02
23532
480.5
35
02
21524
554
15
02
23757
425
37
02
23342
449.5
33
02
23527
515.5
35
02
21525
575
15
02
21120
532.5
11
02
21526
559.5
15
02
23243
439.5
32
02
24030
453
40
03
23704
577.5
37
03
21014
591
10
03
21931
564.5
19
03
23511
584.5
35
03
23343
474
33
03
21716
536
17
03
23953
437.5
39
03
23214
541
32
03
23941
428
39
03
21043
532.5
10
03
23107
633
31
03
21058
384.5
10
03
23553
465
35
03
23253
446
32
03
20941
597.5
9
03
24047
436.5
40
03
23513
589.5
35
03
23323
518.5
33
03
21515
611.5
15
03
20902
672.5
9
03
23510
539
35
03
20956
548.5
9
03
21703
580
17
03
20924
655.5
9
03
23133
604
31
03
23528
474
35
03
21748
474
17
03
23736
439
37
03
23146
558.5
31
03

最佳答案
2014-12-16 11:50
  1. Sub tt()
  2.     Set d = CreateObject("scripting.dictionary")
  3.     rs = 2000
  4.     ReDim arr(1 To rs, 1 To 2)
  5.     k = Int(rs / 30) + 1 '考场个数
  6.     For p = 1 To k - 1   '针对每个考场
  7.         For i = 1 To 30      '选30人
  8. aa:         x = Int((rs * Rnd) + 1)   '任选一人
  9.             If d(x) = 0 And d(x - 1) <> p And d(x + 1) <> p Then         '如果此人未选过,或此人前后号不在此考场中
  10.                 d(x) = p     '选中此人,并作标记
  11.                 arr(x, 1) = x     '此人考号
  12.                 arr(x, 2) = p     '此人考场
  13.             Else         '否则重新选人
  14.                 GoTo aa
  15.             End If
  16.         Next
  17.     Next
  18.     For i = 1 To rs     '剩下的人进最后一个考场
  19.         If d(i) = 0 Then arr(i, 1) = i: arr(i, 2) = p
  20.         If d(i - 1) = p Or d(i + 1) = p Then Call tt     '如果最后一个考场有连号,重新执行程序
  21.     Next
  22.     [a2].Resize(rs, 2).ClearContents     '显示结果
  23.     [a2].Resize(rs, 2) = arr
  24. End Sub
复制代码
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2014-12-16 10:09 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2014-12-16 11:08 | 显示全部楼层
二楼的朋友可以用QQ交流吗?279634558
回复

使用道具 举报

发表于 2014-12-16 11:50 | 显示全部楼层    本楼为最佳答案   
  1. Sub tt()
  2.     Set d = CreateObject("scripting.dictionary")
  3.     rs = 2000
  4.     ReDim arr(1 To rs, 1 To 2)
  5.     k = Int(rs / 30) + 1 '考场个数
  6.     For p = 1 To k - 1   '针对每个考场
  7.         For i = 1 To 30      '选30人
  8. aa:         x = Int((rs * Rnd) + 1)   '任选一人
  9.             If d(x) = 0 And d(x - 1) <> p And d(x + 1) <> p Then         '如果此人未选过,或此人前后号不在此考场中
  10.                 d(x) = p     '选中此人,并作标记
  11.                 arr(x, 1) = x     '此人考号
  12.                 arr(x, 2) = p     '此人考场
  13.             Else         '否则重新选人
  14.                 GoTo aa
  15.             End If
  16.         Next
  17.     Next
  18.     For i = 1 To rs     '剩下的人进最后一个考场
  19.         If d(i) = 0 Then arr(i, 1) = i: arr(i, 2) = p
  20.         If d(i - 1) = p Or d(i + 1) = p Then Call tt     '如果最后一个考场有连号,重新执行程序
  21.     Next
  22.     [a2].Resize(rs, 2).ClearContents     '显示结果
  23.     [a2].Resize(rs, 2) = arr
  24. End Sub
复制代码
回复

使用道具 举报

发表于 2014-12-16 11:51 | 显示全部楼层
做了个例子,一看便知。

工作簿1.rar

23.12 KB, 下载次数: 28

回复

使用道具 举报

 楼主| 发表于 2014-12-16 14:31 | 显示全部楼层
我不太懂,上传了个文件,请看一下
回复

使用道具 举报

发表于 2014-12-16 14:47 | 显示全部楼层
上传的文件在哪儿?
回复

使用道具 举报

发表于 2014-12-17 08:21 | 显示全部楼层
grf1973 发表于 2014-12-16 14:47
上传的文件在哪儿?

grf1973老师:能否实现附件的要求:随机编排试室,每个试室30人,多谢指教。

工作簿1.rar

13.52 KB, 下载次数: 4

回复

使用道具 举报

发表于 2014-12-17 11:10 | 显示全部楼层
请看附件。

工作簿1.rar

18.25 KB, 下载次数: 15

评分

参与人数 1 +2 收起 理由
dyzx + 2

查看全部评分

回复

使用道具 举报

发表于 2014-12-17 11:23 | 显示全部楼层
grf1973 发表于 2014-12-17 11:10
请看附件。

grf1973老师:多谢你帮助,就是这个效果。
抱拳.png
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 06:41 , Processed in 0.543215 second(s), 16 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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