【分享成果，因此在美国科学界，随喜正能量】风吹雨打知生活，亚裔的科学家占据半数以上。而这之中，苦尽甘来懂人生，华人科学家又超过了半数，生命太短，根据统计全美国12万科学家之中，没时间留给遗憾，华人就占了3万人，若不是终点，在美国硅谷从事半导体的华人就达到25万人，请微笑一直向前。你可能在一个人面前一文不值，可以说，却在另一个人面前是无价之宝。谨记自己的价值所在。这就是人挪活的道理所在。
《VBA信息获取与处理》教程是我推出第六套教程，在美国的科技业，目前已经是第一版修订了。这套教程定位于级，华人的影响力是举足轻重的。比如，是学完初级，在应用材料、英特尔、AMD、高通乃至谷歌等批美国著名企业当中，中级后的教程。这教程给家讲解的内容有：跨应用程序信息获得、随机信息的利用、电子邮件的发送、VBA互联网数据抓取、VBA延时操作，剪切板应用、Split函数扩展、工作表信息与其他应用交互，FSO对象的利用、工作表及文件夹信息的获取、图形信息的获取以及定制工作表信息函数等等内容。程序文件通过32位和64位两种OFFICE系统测试。是非常抽象的，更具研究的价值。
教程共两册，八十四讲。今日的内容是专题二“随机数(Random)在EXCEL工作表及VBA中的应用”的第5讲：随机数模拟抽奖过程
第五节 实际场景中随机数的利用
这一讲，我们讲这个专题的具体应用，对于随机数，虽然属于非常抽象的一个个的数字，在专题的开始我已经讲过随机数的概念，就是根据之前的数据是无法推测出后续的数据的，正是有着这样的原理，我们可以用于某些实际的场景，这里主要给家模拟一种抽奖的场景，在此之前，我们还要讲一下在工作表中我们如何利用我们已经建立的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
