vba随机抽取人名不重复_利用随机数完成公司年会抽奖过程

你已选中了添加链接的内容蓝字关注，加微信NZ9668获资料信息

 VBA解决方案   系列丛书作者 

头条百家平台 VBA资深创作者

_______________________________

---

大家好,最近推出的内容是“VBA信息获取与处理”中的部分内容，这套教程面向中高级人员，涉及范围更广，实用性更强，现在的内容是第二个专题“随机数(Random)在EXCEL工作表及VBA中的应用”的内容。s 对于数据处理而言，随机信息的处理是非常重要的一部分，什么是随机数呢？随机数是专门的随机试验的结果。在统计学的不同技术中需要使用随机数，比如在从统计总体中抽取有代表性的样本的时候，或者在将实验动物分配到不同的试验组的过程中等等。 产生随机数有多种不同的方法。这些方法被称为随机数发生器。随机数最重要的特性是：它所产生的后面的那个数与前面的那个数毫无关系。真正的随机数是使用物理现象产生的：比如掷钱币、骰子、转轮、使用电子元件的噪音、核裂变等等，这样的随机数发生器叫做物理性随机数发生器，它们的缺点是技术要求比较高。 计算机或计算器产生的随机数有很长的周期性。其实它们不是真正地随机产生，因为它们实际上是可以计算出来的，但是它们具有类似于随机数的统计特征。这样的发生器叫做伪随机数发生器。在实际应用中往往使用伪随机数就足够了。

第五节 实际场景中随机数的利用

这一讲，我们讲这个专题的具体应用，对于随机数，虽然属于非常抽象的一个个的数字，在专题的开始我已经讲过随机数的概念，就是根据之前的数据是无法推测出后续的数据的，正是有着这样的原理，我们可以用于某些实际的场景，这里主要给大家模拟一种抽奖的场景，再次之前，我们还要讲一下在工作表中我们如何利用我们已经建立的MyRandomA函数。

1 工作表中MyRandomA自定义函数的利用

在代码的讲解中我们知道，MyRandomA函数有四个参数，这四个参数分别是产生随机数的最小值、最大值、要求产生随机数的个数，以及一个数组的下标(这个值不是必须的)。那么我们就在工作表中看看如何利用这个函数。首先我们看看我们的工作表需求： 要求产生一个最大值是10，最小值是40的10个随机数。 ① 我们要首先选中10个(即产生随机数的个数)横向的单元格： ②  在编辑栏录入公式：= MyRandomA(B2,B3,B4)，然后同时按下数组的控制键CTRL+SHIFT+ENTER,就产生了10个我们要求的随机数。为什么要同时按下上面所说的三键呢？有兴趣的朋友可以参考我的《VBA数组与字典解决方案》这套教程。 下面看看产生的随机数截图： 如果要纵向产生十个随机数呢？可以利用公式：=TRANSPOSE(MyRandomA(B2,B3,B4)) 来获得，为什么要利用这个公式呢？同样请朋友们参考我的《VBA数组与字典解决方案》这套教程：

2 利用随机数完成公司年会抽奖过程

很多公司都用年会抽奖的传统，为了达到公平，公正的原则，我们也可以利用随机数进行操作，做一个简单的小程序即可以实现抽奖的过程。这个程序同样在本专题的程序文件中，大家可以利用，这里只是对随机函数部分做讲解，其他的过程大家可以自己理解，比如，上面的抽奖界面，先要抽出的三等奖10名，在点击准备后灰色区域将会出现所有参与抽奖人员的名单滚动，当点击抽奖时将会在“中奖名单即时公示”栏出现此轮抽奖的10名人员名单；当下一轮抽奖时，这轮的人员会下移。 这个抽奖程序可以实现多轮抽奖，每轮抽奖的人数可以设定，中奖人员名单可以即时公布等等优点，非常的方便，可以作为大型及小型年会的娱乐应用。 当然，这其中的VBA代码也很值得学习，很多函数过程利用的十分巧妙。可见VBA在适当的时候也是娱乐的高手。 在抽奖之前，我们要事先录入参与人员的名单： 在每轮开始前，利用总人员名单与已经中奖人员的差集求出此轮参与抽奖人员的中人数。然后利用之前讲解的Function MyRandomA 来完成我们抽奖过程，看下面的代码： Sub MYNZE() '开始抽奖 Sheets("sheet5").Select TT = False Set mydic = CreateObject("scripting.dictionary")    '求两个人名单的差集    PCount = Cells(Rows.Count, "o").End(xlUp).Row    jCount = Cells(Rows.Count, "J").End(xlUp).Row     ARRA = Range("P2:P" & PCount)     ARRB = Range("J1:J" & jCount)     Arr = ARRE(ARRA, ARRB)     Range("C2") = UBound(Arr)     '将人名装入字典      For i = 1 To UBound(Arr)      mydic(i) = Arr(i)     Next '求第几轮的抽奖 RRR = Cells(3, "h").Value If RRR = "" Then   k = 1 Else   k = Mid(RRR, 2, Len(RRR) - 2) + 1 End If '预填已经完成抽奖的数组 KONG = False If Range("J3") <> "" Then ARRC = Range("H3:J" & Cells(2, "J").End(xlDown).Row): KONG = True '开始抽奖 UU = MyRandomA(1, UBound(Arr), Range("B2")) '回填数据  For i = 1 To Range("b2")   Cells(jCount + i, "h") = "第" & k & "轮"   Cells(jCount + i, "i") = Range("a2")   Cells(jCount + i, "j") = mydic(UU(i))  Next  Range("A6") = mydic(UU(i - 1)) Set mydic = Nothing '新中奖名单 ARRD = Range("H" & jCount + 1 & ":J" & Cells(2, "J").End(xlDown).Row) '重置中奖名单 Range("H3:J" & Cells(2, "J").End(xlDown).Row).ClearContents j = 3 For i = UBound(ARRD) To 1 Step -1   Cells(j, "h") = ARRD(i, 1)   Cells(j, "i") = ARRD(i, 2)   Cells(j, "j") = ARRD(i, 3)   j = j + 1 Next If KONG = True Then For i = 1 To UBound(ARRC)   Cells(j, "h") = ARRC(i, 1)   Cells(j, "i") = ARRC(i, 2)   Cells(j, "j") = ARRC(i, 3)   j = j + 1 Next End If MsgBox "你已经完成第" & k & "轮的抽奖！" End Sub 代码截图：   代码讲解：上述代码完成任意轮次的抽奖过程。 ① UU = MyRandomA(1, UBound(Arr), Range("B2")) 这个语句是整个代码的核心部分，其中1是产生随机数的最小值，UBound(Arr)是随机数的最大值，Range("B2")是产生随机数的个数。UU是返回的中奖的人员序号。 ② '回填数据  For i = 1 To Range("b2")   Cells(jCount + i, "h") = "第" & k & "轮"   Cells(jCount + i, "i") = Range("a2")   Cells(jCount + i, "j") = mydic(UU(i))  Next  Range("A6") = mydic(UU(i - 1)) Set mydic = Nothing '新中奖名单 ARRD = Range("H" & jCount + 1 & ":J" & Cells(2, "J").End(xlDown).Row) '重置中奖名单 Range("H3:J" & Cells(2, "J").End(xlDown).Row).ClearContents j = 3 For i = UBound(ARRD) To 1 Step -1   Cells(j, "h") = ARRD(i, 1)   Cells(j, "i") = ARRD(i, 2)   Cells(j, "j") = ARRD(i, 3)   j = j + 1 Next If KONG = True Then For i = 1 To UBound(ARRC)   Cells(j, "h") = ARRC(i, 1)   Cells(j, "i") = ARRC(i, 2)   Cells(j, "j") = ARRC(i, 3)   j = j + 1 Next End If 上述过程是处理应产生的数据,首先是新产生的人员数据回填，这里利用了字典的键值，然后将新产生的数据和已经产生的数据分别放到两个数组中，之后清空数据，再次回填数据，先填新产生的中奖人员，然后再填入已经中奖的人员名单。 最后我们看看实际的截图： 还是非常的漂亮的。在实际的动作中，人员的滚动会是动态的效果，非常的有视觉效果。好了，具体代码还请大家参考本专题的程序文件。

本节知识点回向：值工作表中如何利用VBA中已经定于的函数？随机函数在抽奖过程中是如何利用的？在程序的开始部分，为什么要讲人员的名单放到字典中，这样做的好处是什么？

本节内容详细代码“参考002工作表.XLSM”

VBA是利用Office实现自己小型办公自动化的有效手段，这是我对VBA的应用界定。在取代OFFICE新的办公软件没有到来之前，谁能在数据处理方面做到极致，谁就是王者。其中登峰至极的技能非VBA莫属！学习VBA是个过程，也需要经历一种枯燥的感觉，如太白诗云：众鸟高飞尽，孤云独去闲。相看两不厌，只有敬亭山。

“水善利万物而不争”，绵绵密密，微则无声，巨则汹涌。学习亦如此，知道什么是自己所需要的，不要蜷缩在一小块自认为天堂的世界里，待到暮年时再去做自欺欺人的言论。要努力提高自己，用一颗充满生机的心灵，把握现在，这才是进取。越是有意义的事情，困难会越多。愿力决定始终，智慧决定成败。不管遇到什么，都是风景。看淡纷争，看轻得失。茶，满也好，少也好，不要计较；浓也好，淡也好，其中自有值得品的味道。去感悟真实的时间，静下心，多学习，积累福报。而不是天天混日子，也不是天天熬日子。在后疫情更加严峻的存量残杀世界中，为自己的生存进行知识的储备，特别是新知识的储备。学习时微而无声，利用时则巨则汹涌。

我记得20年前自己初学VBA时，那时的资料甚少，只能看源码自己琢磨,真的很难。20年过去了，为了不让学习VBA的朋友重复我之前的经历，我根据自己多年VBA实际利用经验，推出了六部VBA专门教程。

第一套：VBA代码解决方案 是VBA中各个知识点的讲解，覆盖绝大多数的VBA知识点，初学必备；

第二套：VBA数据库解决方案 数据库是数据处理的专业利器，教程中详细介绍了利用ADO连接ACCDB和EXCEL的方法和实例操作，适合中级人员的学习。

第三套：VBA数组与字典解决方案   数组和字典是VBA的精华，字典是VBA代码水平提高的有效手段，值得深入的学习，是初级及中级人员代码精进的手段。

第四套：VBA代码解决方案之视频是专门面向初学者的视频讲解，可以快速入门，更快的掌握这门技能。

第五套：VBA中类的解读和利用 这是一部高级教程，讲解类的虚无与肉身的度化，类的利用虽然较少，但仔细的学习可以促进自己VBA理论的提高。

第六套教程：《VBA信息获取与处理》，这是一部高级教程，涉及范围更广，实用性更强，面向中高级人员。教程共二十个专题，包括：跨应用程序信息获得、随机信息的利用、电子邮件的发送、VBA互联网数据抓取、VBA延时操作，剪切板应用、Split函数扩展、工作表信息与其他应用交互，FSO对象的利用、工作表及文件夹信息的获取、图形信息的获取以及定制工作表信息函数等等内容。如需要可以可以WeChat: NZ9668

学习的过程也是修心的过程，修一个平静的心。在代码的世界中，心平静了，心情好了，身体自然而然就好。心静则正，内心里没有那么多邪知邪见，也就没有那么多妄想。利人就是利己。这些教程也是为帮助大家起航，助上我自己之力，我的上述教程是我多的经验的传递，大家可以根据以上资料1,3,2,6,5或者是4,3,2,6,5的顺序逐渐深入的逐渐学习。

每一分收获都是成长的记录，怎无凭，正是这种执着，成就了朝霞的灿烂。最后将一阙词送给致力于VBA学习的朋友,让大家感受一下学习过程的枯燥与执着：

浮云掠过，暗语无声，

唯有清风，惊了梦中啼莺。

望星，疏移北斗，

奈将往事雁同行。

阡陌人，昏灯明暗，

忍顾长亭。

多少VBA人，

暗夜中，悄声寻梦，盼却天明。

怎无凭！

分享成果，随喜正能量

_______________________     

有启发 点在看，转给朋友  约作者 请留言，直接交流

更多关联阅读