其实原理很简单，就是把比赛文章列表放到一个工作表（名为复制）中。
然后在另一个工作表中，放好称号，和称号总数。
然后在一个工作表里，制作一个按钮单元格，点击它，调用工作表“复制“里的数据，并为每篇参赛文章指定一个唯一的编号；
制作第二个按钮单元格，点击以后，按是否新人、综合评分、发文时间排序，然后为前三名指定称号；
制作第三个按钮单元格，点击以后，计算幸运奖名额，然后，随机生成数，乘以参与抽奖的文章总数，然后加上3.5，再四舍五入，可以得到中奖的编号。
代码如下：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'初始化
If Target.Address = "$AF$1" Then
Static winner() As String
Static winner_row() As Integer
ReDim winner(0)
ReDim winner_row(0)
Range("B3:B102") = ""
Range("D3:D102") = ""
Range("F3:F102") = ""
Range("H3:H102") = ""
Range("J3:J102") = ""
Range("L3:L102") = ""
Range("N3:N102") = ""
Range("P3:P102") = ""
Range("R3:R102") = ""
Range("T3:T102") = ""
Range("U3:U102") = ""
Range("V3:V102") = ""
Range("W3:W102") = ""
Range("X3:X102") = ""
Range("Y3:Y102") = ""
Range("Z3:Z102") = ""
Range("AA3:AA102") = ""
Range("AB3:AB102") = ""
idno = 1
idno_new = 1
For i = 3 To Worksheets("列表").Range("B112") + 2
Range("D" + CStr(i)).Formula = "=复制!A" + CStr(i - 2)
Range("F" + CStr(i)).Formula = "=复制!B" + CStr(i - 2)
Range("H" + CStr(i)).Formula = "=复制!C" + CStr(i - 2)
Range("J" + CStr(i)).Formula = "=复制!D" + CStr(i - 2)
Range("L" + CStr(i)).Formula = "=复制!E" + CStr(i - 2)
Range("N" + CStr(i)).Formula = "=复制!F" + CStr(i - 2)
Range("P" + CStr(i)).Formula = "=复制!G" + CStr(i - 2)
Range("R" + CStr(i)).Formula = "=IF(D" + CStr(i) + "<>0,(L" + CStr(i) + "+N" + CStr(i) + ")/P" + CStr(i) + ",0)"
Range("U" + CStr(i)).Formula = "=IF(D" + CStr(i) + "<>0,复制!H" + CStr(i - 2) + ",NOW())"
Range("V" + CStr(i)).Formula = "=IF(D" + CStr(i) + "<>0,复制!I" + CStr(i - 2) + ",NOW())"
Range("W" + CStr(i)).Formula = "=IF(D" + CStr(i) + "<>0,复制!J" + CStr(i - 2) + ",NOW())"
Range("X" + CStr(i)).Formula = "=IF(AND(V" + CStr(i) + ">=(W" + CStr(i) + "-61),F" + CStr(i) + "<>0),1,0)"
'为参赛作品生成编号
If Range("D" + CStr(i)) <> "tvb" And Range("D" + CStr(i)) <> "0" And Range("D" + CStr(i)) <> 0 Then
Range("Y" + CStr(i)) = idno
idno = idno + 1
Else
Range("Y" + CStr(i)) = 0
End If
'为新人作品生成编号
If Range("X" + CStr(i)) = 1 And Range("D" + CStr(i)) <> "TVB" Then
Range("Z" + CStr(i)) = idno_new
idno_new = idno_new + 1
Else
Range("Z" + CStr(i)) = 0
End If
Next
End If
'前三名评奖程序
If Target.Address = "$AD$1" Then
ReDim winner(0)
ReDim winner_row(0)
'清空原有奖项
Range("B3:B102") = ""
Range("T3:T102") = ""
Range("AA3:AA102") = ""
Range("AB3:AB102") = ""
'按是否新人、综合指数、发文时间降序排列
Range("D3:Z102").Sort key1:=Range("X1"), order1:=2, key2:=Range("R1"), order2:=2, key3:=Range("U1"), order3:=2
'前三名奖项名
Static prize(3) As String
prize(0) = "<b>一鸣惊人</b>奖"
prize(1) = "<b>一字千钧</b>奖"
prize(2) = "<b>一代风流</b>奖"
'确认前三名
i = 1
j = 3
Do While i <= 3
If Range("D" + CStr(j)) <> "tvb" Then
If i = 1 Then
Range("B" + CStr(j)) = prize(0)
Range("T" + CStr(j)) = i
ReDim Preserve winner(i)
ReDim Preserve winner_row(i)
winner(i - 1) = Range("D" + CStr(j))
winner_row(i - 1) = j
i = i + 1
Else
If (chkrepeat(Range("D" + CStr(j)), winner)) = 0 Then
Range("B" + CStr(j)) = prize(i - 1)
Range("T" + CStr(j)) = i
ReDim Preserve winner(i)
ReDim Preserve winner_row(i)
winner(i - 1) = Range("D" + CStr(j))
winner_row(i - 1) = j
i = i + 1
End If
End If
End If
j = j + 1
Loop
End If
'幸运奖抽奖抽奖程序
If Target.Address = "$AA$1" Then
'清空原有奖项
ReDim Preserve winner(3)
ReDim Preserve winner(4)
Range("AA3:AA102") = ""
Range("AB3:AB102") = ""
Range("B3:B102") = ""
Range("T3:T102") = ""
Dim tmparr(3) As String
For i = 1 To 3
Range("T" + CStr(winner_row(i - 1))) = i
Range("B" + CStr(winner_row(i - 1))) = prize(i - 1)
'tmparr(i - 1) = winner(i - 1)
Next
'抽取cnbuddy幸运点赞奖
Dim lucky() As Integer '中奖作品行数
ReDim Preserve winner(3)
total_new_commer = Range("Z112") '新人作品总数
re = 1
Do While re = 1
rad = Round((total_new_commer - 3) * Rnd + 3.5) '+3是由于从编号第4的人开始抽奖，+0.5是为了保证四舍五入后的概率平均分配（以下同）
author_row = row(rad, "Z3:Z102")
tmp_author = Range("D" + CStr(author_row))
If chkrepeat(tmp_author, winner) = 0 Then
Range("AA" + CStr(3)) = tmp_author
Range("AB" + CStr(3)) = Range("Y" + CStr(author_row))
Range("T" + CStr(author_row)) = CStr(4)
ReDim Preserve winner(4)
ReDim Preserve lucky(1)
winner(3) = tmp_author
lucky(0) = author_row
Range("B" + CStr(author_row)) = "@cnbuddy幸运点赞奖"
re = 0
End If
Loop
Total = Range("Y112") - 3 '作品总数
luck_total = Round(Range("Y112") / 10 + 0.01) '幸运奖总数
luck_name_total = Worksheets("奖项").Range("B1")
i = 1
Do While i <= luck_total
rad = Round(Total * Rnd + 3.5)
author_row = row(rad, "Y3:Y102")
tmp_author = Range("D" + CStr(author_row))
If chkrepeat(tmp_author, winner) = 0 Then '中奖者不重复
If i = 1 Then
Range("AA" + CStr(3 + i)) = tmp_author
Range("AB" + CStr(3 + i)) = rad
Range("T" + CStr(author_row)) = CStr(4 + i)
ReDim Preserve winner(4 + i)
winner(3 + i) = tmp_author
ReDim Preserve lucky(1 + i)
lucky(i) = author_row
luck_row = Round(luck_name_total * Rnd + 0.5)
Range("B" + CStr(author_row)) = "<b>" + Worksheets("奖项").Range("A" + CStr(luck_row)) + "</b>奖"
i = i + 1
Else
If chkrepeat(rad, lucky) = 0 Then
Range("AA" + CStr(3 + i)) = tmp_author
Range("AB" + CStr(3 + i)) = rad
Range("T" + CStr(author_row)) = CStr(4 + i)
ReDim Preserve winner(4 + i)
winner(3 + i) = tmp_author
ReDim Preserve lucky(1 + i)
lucky(i) = author_row
luck_row = Round(luck_name_total * Rnd + 0.5)
Range("B" + CStr(author_row)) = "<b>" + Worksheets("奖项").Range("A" + CStr(luck_row)) + "</b>奖"
i = i + 1
End If
End If
End If
Loop
Range("b3:Z102").Sort key1:=Range("T1"), order1:=1
End If
End Sub
讲着累，大家看代码吧。
另外还有两个函数：
'获取行数的函数
Public Function row(value, area)
For Each Rng In Range(area)
If (Rng = value) Then
row = Rng.row
End If
Next
End Function
'查询某值是否在某数组中（检查是否重复）
Public Function chkrepeat(value, arr)
chkrepeat = 0
For Each a In arr
If a = value Then
chkrepeat = 1
Exit For
End If
Next
End Function
文件在github上：
https://github.com/wozhuibenle/excel-prize-draw
先运行“初始化”、再运行评奖，最后运行抽取幸运奖，过程如下：
