《VBA信息获取与处理》教程(版权10178984)是我推出第六套教程，目前已经是第一版修订了。这套教程定位于最高级，是学完初级，中级后的教程。这部教程给大家讲解的内容有：跨应用程序信息获得、随机信息的利用、电子邮件的发送、VBA互联网数据抓取、VBA延时操作，剪贴板应用、Split函数扩展、工作表信息与其他应用交互，FSO对象的利用、工作表及文件夹信息的获取、图形信息的获取以及定制工作表信息函数等等内容。程序文件通过32位和64位两种OFFICE系统测试。是非常抽象的，更具研究的价值。
【分享成果，随喜正能量】人一辈子，只能靠长期去做某件事情来成就自己，而不是靠某一个人来成就自己。关于这点，你要么及早领悟，要么等待时光给出教训，逼你领悟。
第五节 实际场景中随机数的利用这一讲，我们讲这个专题的具体应用，对于随机数，虽然属于非常抽象的一个个的数字，在专题的开始我已经讲过随机数的概念，就是根据之前的数据是无法推测出后续的数据的，正是有着这样的原理，我们可以用于某些实际的场景，这里主要给大家模拟一种抽奖的场景，在此之前，我们还要讲一下在工作表中我们如何利用我们已经建立的MyRandomA函数。
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”
我20多年的VBA实践经验，全部浓缩在下面的各个教程中，教程学习顺序：
