VBA สุ่มตัวเลขทำบัตรBingo ด้วย VBA

VBA สุ่มตัวเลขทำบัตรBingo

——————

แหม จั่วหัวแบบนี้ ก็ต้องบอกกันก่อนนะครับว่าไม่ได้ส่งเสริมให้ใช้เป็นการพนันนะครับ…

ที่มาที่ไปของโค้ดชุดนี้คือ เมื่อตอนที่เป็นเด็กผมเคยอยู่ในโรงเรียนคริสต์ และวันคริสตมาสก็จะมีการจัดกิจกรรมให้เด็ก ๆ มากมาย หนึ่งในกิจกรรมวันคริสตมาสคือการเล่นบิงโก เอาขนมมาแจกเด็ก ๆ แบบมีความสนุกไปด้วยนั่นเอง…

และเมื่อไม่นานมานี้เพื่อนที่เคยเรียนด้วยกันสมัยนั้นเกิดอยากจัดบิงโกที่บริษัทที่ทำงาน แต่บัตรบิงโกไม่มีนี่ซิ ทำไงดี

เพื่อนคนนั้นก็พยายามใช้ความสามารถ Excel ใช้สูตร RANDBETWEEN() เพื่อสุ่มจำนวนเลขลงตารางในขอบเขตของแต่ละแถว แต่ปรากฏว่ามันเกิดปัญหาคือ “มันเป็นไปได้ว่าค่าที่สุ่มมาจะซ้ำกัน!!!!”

และก็โทรฯมาหาเพื่อนชาติ นี่แหละเห็นมันสอน Excel อยู่ 5 5 5 5 จึงเป็นที่มาของโค้ดชุดนี้ครับ

ตารางบิงโก เป็นตารางขนาด 5×5 มีตัวเลขสุ่มกระจายกันใน 25 ช่องไม่มีตัวเลขซ้ำกัน

ตัวเลขที่เอามาสุ่มลงในตารางแบ่งเป็น 5 คอลัมน์ คือ B-I-N-G และ O
ตัวเลขในคอลัมน์ B เป็นได้แค่ 1-15
คอลัมน์ I เป็นได้แค่ 16-30
คอลัมน์ N เป็นได้แค่ 31-45
คอลัมน์ G เป็นได้แค่ 46-60
คอลัมน์ O เป็นได้แค่ 61-75

แต่ละตารางสามารถซ้ำกันได้ แต่ในตารางเดียวกันต้องไม่มีเลขซ้ำกันเลย

งานนี้ก็ใช้เวลาคิดนานอยู่นะครับ…ร่วม ครึ่งชั่วโมงทีเดียว 5 5 5 ที่สุดก็ได้โค้ดมาแบบนี้ครับ

Download ไปศึกษาดูได้ที่นี่ครับ https://drive.google.com/file/d/102YY6EzmGRSOzskUiSNstKQ6S8MpAwEh/view

 

 

 

ขอให้สนุกกับการเรียนและการใช้งาน Excel VBA ทุกวันครับ
——————–

Sub genNumber()

Dim cell_1 As Range
Dim cell_2 As Range
Dim startNum As Long
Dim endNum As Long
Dim inputNum As Long

For Each cell_1 In Range(“A3:AA7”)
If Cells(2, cell_1.Column) <> “” Then
If Cells(2, cell_1.Column) = “B” Then
startNum = 1: endNum = 15
ElseIf Cells(2, cell_1.Column) = “I” Then
startNum = 16: endNum = 30
ElseIf Cells(2, cell_1.Column) = “N” Then
startNum = 31: endNum = 45
ElseIf Cells(2, cell_1.Column) = “G” Then
startNum = 46: endNum = 60
Else
startNum = 61: endNum = 75
End If
reGenNum:
inputNum = WorksheetFunction.RandBetween(startNum, endNum)
If WorksheetFunction.CountIf(Range(Cells(3, cell_1.Column), Cells(7, cell_1.Column)), inputNum) = 0 Then
cell_1.Value = inputNum
Else
GoTo reGenNum
End If

End If
Next cell_1

For Each cell_2 In Range(“A11:AA15”)
If Cells(2, cell_2.Column) <> “” Then
If Cells(2, cell_2.Column) = “B” Then
startNum = 1: endNum = 15
ElseIf Cells(2, cell_2.Column) = “I” Then
startNum = 16: endNum = 30
ElseIf Cells(2, cell_2.Column) = “N” Then
startNum = 31: endNum = 45
ElseIf Cells(2, cell_2.Column) = “G” Then
startNum = 46: endNum = 60
Else
startNum = 61: endNum = 75
End If
reGenNum2:
inputNum = WorksheetFunction.RandBetween(startNum, endNum)
If WorksheetFunction.CountIf(Range(Cells(11, cell_2.Column), Cells(15, cell_2.Column)), inputNum) = 0 Then
cell_2.Value = inputNum
Else
GoTo reGenNum2
End If
End If
Next cell_2

MsgBox “Done !!!!”
End Sub