想運用Excel做個抽獎

　暱稱: VBA向前衝

帖子: 559
主題: 58
精華: 0
積分: 626
點名: 0
作業系統: win8
軟體版本: office2013
閱讀權限: 50
性別: 男
來自: TW
註冊時間: 2010-11-22
最後登錄: 2024-6-14

2^#

發表於 2014-12-20 13:01 | 只看該作者

回復 1# K_Wing

用公式的話，可能會有問題，
抽獎本身就是隨機的，所以你同事用亂數的方式是對的方向，
但是，就我使用亂數的情況，只要儲存格有改變到，該亂數就會被執行，
因此，我只有用vba的方式來處理，請下載附擋，應該可以符合你的需求。

抽獎方式.rar (12.45 KB)

學習才能提升自己

帖子: 140
主題: 27
精華: 0
積分: 158
點名: 0
作業系統: Windows10
軟體版本: office 2013
閱讀權限: 20
性別: 男
註冊時間: 2014-11-27
最後登錄: 2023-2-26

3^#

發表於 2014-12-20 18:34 | 只看該作者

回復 2# hugh0620
^^~
非常感謝兄弟幫忙
是這樣的模式了
可是按鈕放得過高
如果可以調低至F35的位置
就最好了

　暱稱: VBA向前衝

帖子: 559
主題: 58
精華: 0
積分: 626
點名: 0
作業系統: win8
軟體版本: office2013
閱讀權限: 50
性別: 男
來自: TW
註冊時間: 2010-11-22
最後登錄: 2024-6-14

4^#

發表於 2014-12-21 00:36 | 只看該作者

回復 3# K_Wing

操作圖示，請自己試著移動看看，才能增加你的EXCEL能力。

學習才能提升自己

帖子: 140
主題: 27
精華: 0
積分: 158
點名: 0
作業系統: Windows10
軟體版本: office 2013
閱讀權限: 20
性別: 男
註冊時間: 2014-11-27
最後登錄: 2023-2-26

5^#

發表於 2014-12-21 22:15 | 只看該作者

回復 4# hugh0620
^^~成功了
感謝指導
另想問問若想
若我想以圖片內的情況顯示抽出號碼
比如話移位後的21至100
旁邊的空格已沒法顯示號碼
可以怎樣做呢

另大空格的"37"
除了使用公式"=B2"
還可以怎樣使它自動顯示

　暱稱: VBA向前衝

帖子: 559
主題: 58
精華: 0
積分: 626
點名: 0
作業系統: win8
軟體版本: office2013
閱讀權限: 50
性別: 男
來自: TW
註冊時間: 2010-11-22
最後登錄: 2024-6-14

6^#

發表於 2014-12-22 08:26 | 只看該作者

本帖最後由 hugh0620 於 2014-12-22 08:30 編輯

回復 5# K_Wing

B1改成P6
B2改成K14
另外要把每一排依20個人來使用，要再加工一下。

學習才能提升自己

帖子: 140
主題: 27
精華: 0
積分: 158
點名: 0
作業系統: Windows10
軟體版本: office 2013
閱讀權限: 20
性別: 男
註冊時間: 2014-11-27
最後登錄: 2023-2-26

7^#

發表於 2014-12-22 08:33 | 只看該作者

回復 6# hugh0620
萬二分感謝
問題已圓滿解決:)

　暱稱: VBA向前衝

帖子: 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

複製代碼

學習才能提升自己

帖子: 140
主題: 27
精華: 0
積分: 158
點名: 0
作業系統: Windows10
軟體版本: office 2013
閱讀權限: 20
性別: 男
註冊時間: 2014-11-27
最後登錄: 2023-2-26

9^#

發表於 2014-12-22 10:36 | 只看該作者

回復 K_Wing
1. 將舊的程式碼全部刪除
2.將下面的程式碼全部貼上，應該就是你要的結果

我用的是比較 ...
hugh0620 發表於 2014-12-22 09:43

非常感謝一再講解
因不同部門有著不同的意見
總不能每次出現新意見後又再上來提問

負責的同事已修改為公式
將原有21-100的文字全改為白色
讓這系列的儲存格變成空白
然後在新的位置貼上"=原有儲存格的公式"再下拉
暫時來說總算解決了問題

再次感謝兄弟的熱心幫忙
謝謝