Excel
工作表1，程序主界面，如图。此例中一共四个奖项，三等，二等，一等和特等，分别是5个，5个，3个和1个获奖人。如果获奖人未到场，可以点中TA的名字，点击'Get a Bckup'按钮，进行替换。
工作表2，候选人名单，在A列连续输入即可
VBA代码：Private Declare Sub sleep Lib 'kernel32' (ByVal dwmilliseconds As Long)Dim d1 As New DictionaryDim is_stop As BooleanDim arr, i, j, kDim d As New DictionaryPrivate Sub btn_BUP_Click()btn_Get.Enabled = Falsebtn_BUP.Enabled = FalseIf Selection.Cells.Count = 1 ThenIf (Selection.Cells.Column = 1 And Selection.Cells.Row > 7) Or (Selection.Cells.Column = 2 And Selection.Cells.Row > 7) Or _(Selection.Cells.Column = 3 And Selection.Cells.Row > 5) Or (Selection.Cells.Column = 4 And Selection.Cells.Row > 3) Or _(Selection.Cells.Column > 4) Then MsgBox 'Please select the right cell.' btn_Get.Enabled = True btn_BUP.Enabled = True Exit SubEnd IfSheet1.btn_Stop.Enabled = Truearr = Sheets(2).UsedRangeWhile is_stop = False DoEvents i = 0 Do While i < 1 j = Int(Rnd() * UBound(arr) + 1) If (Not d.exists(j)) And (Not d1.exists(j)) Then i = i + 1 d(j) = arr(j, 1) If is_stop Then d1(j) = arr(j, 1) End If Loop Selection.Resize(d.Count, 1) = Application.Transpose(d.items) d.RemoveAllWendis_stop = FalseElseMsgBox 'Please select only one cell.' ' & vbnewline & vbnewline & Please select the right cell!'btn_Get.Enabled = Truebtn_BUP.Enabled = TrueExit SubEnd Ifbtn_Get.Enabled = Truebtn_BUP.Enabled = TrueEnd SubPrivate Sub btn_Get_Click()'Chao Ma'11/19/2014'toni8330@gmail.combtn_BUP.Enabled = Falsebtn_Get.Enabled = Falsearr = Sheets(2).UsedRangeSelect Case btn_Get.Caption Case 'Ready' btn_Get.Caption = 'Get the third Prize' Sheets(1).Range('A3:D18').ClearContents Case 'Get the third Prize' Sheet1.btn_Stop.Enabled = True 'btn_Get.Caption = 'Stop' 'Range('A2:A7').Select 'ActiveSheet.Unprotect ' DrawingObjects:=True, Contents:=True, Scenarios:=True Range('A2:A7').Borders(xlDiagonalDown).LineStyle = xlNone Range('A2:A7').Borders(xlDiagonalUp).LineStyle = xlNone With Range('A2:A7').Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Range('A2:A7').Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Range('A2:A7').Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Range('A2:A7').Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Range('A2:A7').Borders(xlInsideVertical).LineStyle = xlNone While is_stop = False DoEvents i = 0 Do While i < 5 j = Int(Rnd() * UBound(arr) + 1) If (Not d.exists(j)) And (Not d1.exists(j)) Then i = i + 1 d(j) = arr(j, 1) If is_stop Then d1(j) = arr(j, 1) End If Loop Range('a3').Resize(d.Count, 1) = Application.Transpose(d.items) d.RemoveAll Wend btn_Get.Caption = 'Get the second Prize' is_stop = False 'ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True Case 'Get the second Prize' Sheet1.btn_Stop.Enabled = True 'ActiveSheet.Unprotect' Range('A2:A7').Select Range('A2:A7').Borders(xlDiagonalDown).LineStyle = xlNone Range('A2:A7').Borders(xlDiagonalUp).LineStyle = xlNone Range('A2:A7').Borders(xlEdgeLeft).LineStyle = xlNone Range('A2:A7').Borders(xlEdgeTop).LineStyle = xlNone Range('A2:A7').Borders(xlEdgeBottom).LineStyle = xlNone Range('A2:A7').Borders(xlEdgeRight).LineStyle = xlNone Range('A2:A7').Borders(xlInsideVertical).LineStyle = xlNone Range('A2:A7').Borders(xlInsideHorizontal).LineStyle = xlNone ' Range('B2:B7').Select Range('B2:B7').Borders(xlDiagonalDown).LineStyle = xlNone Range('B2:B7').Borders(xlDiagonalUp).LineStyle = xlNone With Range('B2:B7').Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Range('B2:B7').Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Range('B2:B7').Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Range('B2:B7').Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Range('B2:B7').Borders(xlInsideVertical).LineStyle = xlNone While is_stop = False DoEvents i = 0 Do While i < 5 j = Int(Rnd() * UBound(arr) + 1) If (Not d.exists(j)) And (Not d1.exists(j)) Then i = i + 1 d(j) = arr(j, 1) If is_stop Then d1(j) = arr(j, 1) End If Loop Range('b3').Resize(d.Count, 1) = Application.Transpose(d.items) d.RemoveAll Wend btn_Get.Caption = 'Get the first Prize' is_stop = False 'ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True Case 'Get the first Prize' Sheet1.btn_Stop.Enabled = True 'ActiveSheet.Unprotect' Range('B2:B7').Select Range('B2:B7').Borders(xlDiagonalDown).LineStyle = xlNone Range('B2:B7').Borders(xlDiagonalUp).LineStyle = xlNone Range('B2:B7').Borders(xlEdgeLeft).LineStyle = xlNone Range('B2:B7').Borders(xlEdgeTop).LineStyle = xlNone Range('B2:B7').Borders(xlEdgeBottom).LineStyle = xlNone Range('B2:B7').Borders(xlEdgeRight).LineStyle = xlNone Range('B2:B7').Borders(xlInsideVertical).LineStyle = xlNone Range('B2:B7').Borders(xlInsideHorizontal).LineStyle = xlNone 'Range('C2:C5').Select Range('C2:C5').Borders(xlDiagonalDown).LineStyle = xlNone Range('C2:C5').Borders(xlDiagonalUp).LineStyle = xlNone With Range('C2:C5').Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Range('C2:C5').Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Range('C2:C5').Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Range('C2:C5').Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Range('C2:C5').Borders(xlInsideVertical).LineStyle = xlNone While is_stop = False DoEvents i = 0 Do While i < 3 j = Int(Rnd() * UBound(arr) + 1) If (Not d.exists(j)) And (Not d1.exists(j)) Then i = i + 1 d(j) = arr(j, 1) If is_stop Then d1(j) = arr(j, 1) End If Loop Range('c3').Resize(d.Count, 1) = Application.Transpose(d.items) d.RemoveAll Wend btn_Get.Caption = 'Get the GRAND Prize' is_stop = False 'ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True Case 'Get the GRAND Prize' Sheet1.btn_Stop.Enabled = True 'ActiveSheet.Unprotect 'Range('C2:C5').Select Range('C2:C5').Borders(xlDiagonalDown).LineStyle = xlNone Range('C2:C5').Borders(xlDiagonalUp).LineStyle = xlNone Range('C2:C5').Borders(xlEdgeLeft).LineStyle = xlNone Range('C2:C5').Borders(xlEdgeTop).LineStyle = xlNone Range('C2:C5').Borders(xlEdgeBottom).LineStyle = xlNone Range('C2:C5').Borders(xlEdgeRight).LineStyle = xlNone Range('C2:C5').Borders(xlInsideVertical).LineStyle = xlNone Range('C2:C5').Borders(xlInsideHorizontal).LineStyle = xlNone' 'Range('D2:D3').Select Range('D2:D3').Borders(xlDiagonalDown).LineStyle = xlNone Range('D2:D3').Borders(xlDiagonalUp).LineStyle = xlNone With Range('D2:D3').Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Range('D2:D3').Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Range('D2:D3').Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Range('D2:D3').Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Range('D2:D3').Borders(xlInsideVertical).LineStyle = xlNone While is_stop = False DoEvents i = 0 Do While i < 1 j = Int(Rnd() * UBound(arr) + 1) If (Not d.exists(j)) And (Not d1.exists(j)) Then i = i + 1 d(j) = arr(j, 1) If is_stop Then d1(j) = arr(j, 1) End If Loop Range('d3').Resize(d.Count, 1) = Application.Transpose(d.items) d.RemoveAll Wend btn_Get.Caption = 'Print as PDF' is_stop = False 'Range('D2:D3').Select Range('D2:D3').Borders(xlDiagonalDown).LineStyle = xlNone Range('D2:D3').Borders(xlDiagonalUp).LineStyle = xlNone Range('D2:D3').Borders(xlEdgeLeft).LineStyle = xlNone Range('D2:D3').Borders(xlEdgeTop).LineStyle = xlNone Range('D2:D3').Borders(xlEdgeBottom).LineStyle = xlNone Range('D2:D3').Borders(xlEdgeRight).LineStyle = xlNone Range('D2:D3').Borders(xlInsideVertical).LineStyle = xlNone Range('D2:D3').Borders(xlInsideHorizontal).LineStyle = xlNone 'Range('C7').Select Range('A2:D2').Borders(xlDiagonalDown).LineStyle = xlNone Range('A2:D2').Borders(xlDiagonalUp).LineStyle = xlNone Range('A2:D2').Borders(xlEdgeLeft).LineStyle = xlNone Range('A2:D2').Borders(xlEdgeTop).LineStyle = xlNone With Range('A2:D2').Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Range('A2:D2').Borders(xlEdgeRight).LineStyle = xlNone Range('A2:D2').Borders(xlInsideVertical).LineStyle = xlNone Range('A2:D2').Borders(xlInsideHorizontal).LineStyle = xlNone 'ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True Case 'Print as PDF' ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ Environ('UserProfile') & '\Desktop\LuckyDraw_MS.pdf', Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ True btn_Get.Caption = 'Ready' is_stop = FalseEnd Selectbtn_BUP.Enabled = Truebtn_Get.Enabled = TrueEnd SubPrivate Sub btn_Stop_Click()is_stop = TrueSheet1.btn_Stop.Enabled = FalseEnd Sub
工作簿打开时清理上次结果Private Sub Workbook_Open()Sheets(1).Range('A3:D18').ClearContentsSheet1.btn_Get.Caption = 'Ready'Sheet1.btn_Stop.Enabled = FalseEnd Sub
第一个按钮承担了大部分的功能，请根据上面的文字进行操作
请根据代码，给按钮命名