麻辣家族討論版版 - Powered by Discuz! Board

Sub 產生抽獎次數()
Dim A As Integer
'A = Range("B1") '抽獎人數
'Range("B2").ClearContents
'Range("A5:B65536").ClearContents '清除舊的次數
A = Range("P6") '抽獎人數
B = 20 '20人一排
C = A / B '整數有多少排(ex. C=100/20=5)
If C = Int(C) Then
D = C '當C是整數的時候，D等於C幾排，迴圈要跑的次數
Else
D = Int(C) + 1 '當C不是整數的時候，D等於C幾排+1，迴圈要跑的次數
End If
Range("A4").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).ClearContents
P = 1
For J = 0 To D - 1
Cells(4, J * 2 + 1) = "工號(姓名)"
Cells(4, J * 2 + 2) = "抽中號碼"
For I = 1 To B '產生編號
Cells(I + 4, J * 2 + 1) = P
P = P + 1
Next I
Next J
End Sub
Sub 一次抽一個編號()
A = Range("P6") '抽獎人數
B = 20 '20人一排
C = A / B '整數有多少排(ex. C=100/20=5)
If C = Int(C) Then
D = C '當C是整數的時候，D等於C幾排，迴圈要跑的次數
Else
D = Int(C) + 1 '當C不是整數的時候，D等於C幾排+1，迴圈要跑的次數
End If
'==== 確定號碼不會重複==========
1
K = Int(Round(Rnd(), 3) * 100)
If K > A Then
GoTo 1
End If
For J = 0 To D - 1
For I = 1 To B '產生編號
If K = Cells(I + 4, J * 2 + 2) Then
GoTo 1
End If
Next I
Next J
'==== 確定號碼不會重複==========
P = Application.CountA(Range("B5:B24"), Range("D5:D24"), Range("F5:F24"), Range("H5:H24"), Range("J5:J24"))
If P < 20 Then
Range("K14") = K
If P = 0 Then
Cells(4, 2).Offset(1, 0) = K
Else
Cells(4, 2).End(xlDown).Offset(1, 0) = K
End If
ElseIf P >= 20 And P < 40 Then
Range("K14") = K
If P = 20 Then
Cells(4, 4).Offset(1, 0) = K
Else
Cells(4, 4).End(xlDown).Offset(1, 0) = K
End If
ElseIf P >= 40 And P < 60 Then
Range("K14") = K
If P = 40 Then
Cells(4, 6).Offset(1, 0) = K
Else
Cells(4, 6).End(xlDown).Offset(1, 0) = K
End If
ElseIf P >= 60 And P < 80 Then
Range("K14") = K
If P = 60 Then
Cells(4, 8).Offset(1, 0) = K
Else
Cells(4, 8).End(xlDown).Offset(1, 0) = K
End If
ElseIf P >= 80 And P < 100 Then
Range("K14") = K
If P = 80 Then
Cells(4, 10).Offset(1, 0) = K
Else
Cells(4, 10).End(xlDown).Offset(1, 0) = K
End If
ElseIf P >= 100 Then
MsgBox "已完抽獎"
GoTo 2
End If
2
End Sub

複製代碼