用excel制作抽奖功能--“三好兔噢”抽奖方法公示

in cn •  7 years ago  (edited)

其实原理很简单，就是把比赛文章列表放到一个工作表（名为复制）中。

然后在另一个工作表中，放好称号，和称号总数。

然后在一个工作表里，制作一个按钮单元格，点击它，调用工作表“复制“里的数据，并为每篇参赛文章指定一个唯一的编号；

制作第二个按钮单元格，点击以后，按是否新人、综合评分、发文时间排序，然后为前三名指定称号；

制作第三个按钮单元格，点击以后，计算幸运奖名额，然后，随机生成数，乘以参与抽奖的文章总数，然后加上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

先运行“初始化”、再运行评奖，最后运行抽取幸运奖，过程如下：

121.gif

cn cn-programming cn-31 cn-voice cn-funny
7 years ago by

Downvoting a post can decrease pending rewards and make it less visible. Common reasons:

  • Disagreement on rewards
  • Fraud or plagiarism
  • Hate speech or trolling
  • Miscategorized content or spam

Submit
$4.54
  • Past Payouts $4.54
  • - Author $3.67
  • - Curators $0.87
32 votes
15
Authors get paid when people like you upvote their post.
If you enjoyed what you read here, create your account today and start earning FREE STEEM!
Sort Order:  
  • Trending
    • [-]
      ·  7 years ago 

    @tvb, 得到朕的雨露均沾的...你的声音会更优美...

    Downvoting a post can decrease pending rewards and make it less visible. Common reasons:

    • Disagreement on rewards
    • Fraud or plagiarism
    • Hate speech or trolling
    • Miscategorized content or spam

    Submit
    $0.00
      [-]
        ·  7 years ago 

      @tvb, 这是小可可我在steemit最好的邂逅，好喜欢你的声音（＾∀＾）哇~~~ img

      BTW, @cn-naughty.boy 淘气包你讨厌，抢伦家沙发~哼~~~ (>_<、)

      Downvoting a post can decrease pending rewards and make it less visible. Common reasons:

      • Disagreement on rewards
      • Fraud or plagiarism
      • Hate speech or trolling
      • Miscategorized content or spam

      Submit
      $0.00
        [-]
          ·  7 years ago 

        一姐，这个代码到时我可能会用到，谢谢你的分享～

        Downvoting a post can decrease pending rewards and make it less visible. Common reasons:

        • Disagreement on rewards
        • Fraud or plagiarism
        • Hate speech or trolling
        • Miscategorized content or spam

        Submit
        $0.00
          [-]
            ·  7 years ago 

          好像要设置一下才能用，等我编辑一下。

          Downvoting a post can decrease pending rewards and make it less visible. Common reasons:

          • Disagreement on rewards
          • Fraud or plagiarism
          • Hate speech or trolling
          • Miscategorized content or spam

          Submit
          $0.00
            [-]
              ·  7 years ago 

            好的 :)

            Downvoting a post can decrease pending rewards and make it less visible. Common reasons:

            • Disagreement on rewards
            • Fraud or plagiarism
            • Hate speech or trolling
            • Miscategorized content or spam

            Submit
            $0.00
              [-]
                ·  7 years ago (edited)

              To do or not to do? That is the question.:-)

              Downvoting a post can decrease pending rewards and make it less visible. Common reasons:

              • Disagreement on rewards
              • Fraud or plagiarism
              • Hate speech or trolling
              • Miscategorized content or spam

              Submit
              $0.00
                [-]
                  ·  7 years ago 

                英语不好呀哥。。。。

                Downvoting a post can decrease pending rewards and make it less visible. Common reasons:

                • Disagreement on rewards
                • Fraud or plagiarism
                • Hate speech or trolling
                • Miscategorized content or spam

                Submit
                $0.00
                  [-]
                    ·  7 years ago 

                  沒什麽。只是因兔字押韻一下。:-)

                  Downvoting a post can decrease pending rewards and make it less visible. Common reasons:

                  • Disagreement on rewards
                  • Fraud or plagiarism
                  • Hate speech or trolling
                  • Miscategorized content or spam

                  Submit
                  $0.00
                    [-]
                      ·  7 years ago 

                    我明白了，我发了这么多，假如幸运奖抽不到我，我得多不幸😂

                    Downvoting a post can decrease pending rewards and make it less visible. Common reasons:

                    • Disagreement on rewards
                    • Fraud or plagiarism
                    • Hate speech or trolling
                    • Miscategorized content or spam

                    Submit
                    $0.00
                      [-]
                        ·  7 years ago 

                      你不是第三名嘛，我特意看的，别人我都不看直接复制的哈哈。我觉得要再调调综合评分的计算方法了，现在有点偏向新人哈哈

                      Downvoting a post can decrease pending rewards and make it less visible. Common reasons:

                      • Disagreement on rewards
                      • Fraud or plagiarism
                      • Hate speech or trolling
                      • Miscategorized content or spam

                      Submit
                      $0.00
                        [-]
                          ·  7 years ago 

                        哦，看不懂的excel系列。

                        我就只会用RANK和INDEX搞点简单小抽奖。

                        Downvoting a post can decrease pending rewards and make it less visible. Common reasons:

                        • Disagreement on rewards
                        • Fraud or plagiarism
                        • Hate speech or trolling
                        • Miscategorized content or spam

                        Submit
                        $0.00
                          [-]
                            ·  7 years ago 

                          这也是随机函数呀，但因为要考虑重复的问题，比如有3个幸运奖，不能抽到重复的编号。再就是有的人一稿多投，抽到的概率确实是高，但只能得一次奖，如果重复了就要重新抽。就这点事。
                          而且前三名也是用的程序，我就不用自己数了嘛。

                          Downvoting a post can decrease pending rewards and make it less visible. Common reasons:

                          • Disagreement on rewards
                          • Fraud or plagiarism
                          • Hate speech or trolling
                          • Miscategorized content or spam

                          Submit
                          $0.00
                            [-]
                              ·  7 years ago 

                            收藏了，谢谢@tvb姐分享，完全不懂代码，需要的时候直接复制粘贴运行，哈哈...

                            Downvoting a post can decrease pending rewards and make it less visible. Common reasons:

                            • Disagreement on rewards
                            • Fraud or plagiarism
                            • Hate speech or trolling
                            • Miscategorized content or spam

                            Submit
                            $0.00
                              [-]
                                ·  7 years ago 

                              excel代码这一块我都不会用……
                              看来得好好进修一下……

                              Downvoting a post can decrease pending rewards and make it less visible. Common reasons:

                              • Disagreement on rewards
                              • Fraud or plagiarism
                              • Hate speech or trolling
                              • Miscategorized content or spam

                              Submit
                              $0.00
                                [-]
                                  ·  7 years ago 

                                一姐，你也太厉害了吧，哈哈

                                Downvoting a post can decrease pending rewards and make it less visible. Common reasons:

                                • Disagreement on rewards
                                • Fraud or plagiarism
                                • Hate speech or trolling
                                • Miscategorized content or spam

                                Submit
                                $0.00