- 帖子
- 559
- 主題
- 58
- 精華
- 0
- 積分
- 626
- 點名
- 0
- 作業系統
- win8
- 軟體版本
- office2013
- 閱讀權限
- 50
- 性別
- 男
- 來自
- TW
- 註冊時間
- 2010-11-22
- 最後登錄
- 2024-6-14
|
8#
發表於 2014-12-22 09:43
| 只看該作者
本帖最後由 hugh0620 於 2014-12-22 09:45 編輯
回復 5# K_Wing
1. 將舊的程式碼全部刪除
2.將下面的程式碼全部貼上，應該就是你要的結果
我用的是比較直接邏輯性的判斷來完成，所以會比較長，
沒太多時間簡化程式碼，其他大大應該有更簡便的方式。- 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
|
|
