Snasui Excel Forum

snasui wrote: Mon Dec 24, 2018 6:16 pm เนื่องจากการสุ่มเป็นการสุ่มโดยการ Fixed ตำแหน่งเอาไว้แล้วว่าจะเอาค่าใดมาแสดง

ในพื้นที่ E4:N13 เป็นการนำค่าใน Q7:Q200 มาแสดง และจะแสดงในรูปแบบเดิมเสมอ ช่องที่ 1 แสดงเลข 1 ช่องที่ 2 แสดงเลข 2...จนถึงช่องที่ 100 แสดงเลข 100

ผมไม่เคยศึกษาวิธีการเล่น Bingo ช่วยเล่าว่าต้องการจะให้แสดงผลเช่นไรมาด้วยครับ

Sub RandomName()
Dim i As Integer
Dim j As Integer
'Application.OnTime Now() + TimeValue("00:00:05"), "RandomName"
On Error Resume Next
With Worksheets("รหัสตัวเลข")
    j = .Range("A65536").End(xlUp).Row - 1
    i = Int(Rnd * (j - 1) + 1)
    Set r = .Cells(i, 1)
End With
    r.Copy
With Worksheets("แสดงผล")
    .Range("D3").PasteSpecial xlPasteValues
    .Shapes("Button 12").Visible = True
End With
     Application.CutCopyMode = False
End Sub

snasui wrote: Mon Dec 24, 2018 2:48 pm ผมกดแป้น F9 แล้วเห็นว่ามีการสุ่มสลับกันตามปกติครับ

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

snasui wrote: Mon Dec 24, 2018 1:43 pm ช่วงเซลล์ในสูตรในชีต IndexRandom ตรงคอลัมน์ E ไม่ครอบคลุมข้อมูลที่ใช้

ที่เซลล์ E2 ควรปรับเป็นด้านล่างครับ

=INDEX($A$2:$A$101,MATCH(ROWS($E$2:E2),$C$2:$C$101,0))

snasui wrote: Fri Dec 21, 2018 7:12 pm ช่วยโพสต์ Code ให้แสดงเป็น Code ตามกฎการใช้บอร์ดข้อ 5 ด้านบนด้วยครับ

Thaipichit Pomwong wrote: Fri Dec 21, 2018 5:56 pm ถึงอาจารย์และเพื่อนๆทุกคนครับ

ผมไม่เข้าใจว่าทำไม เมื่อทำการ random แล้วถึงเหลือค่าตัวเลขติดอยู่ 1 ค่าที่ไม่ถูก random ครับ
จะต้องแก้ไขหรือปรับเปลี่ยนตรงไหนอย่างไร รบกวนช่วยดูและแนะนำให้หน่อยนะครับ
การสุ่มตัวเลขBinGO.xlsm
ตัวอย่าง VBA

Code: Select all

Dim r As Range
Sub RandomName()
Dim i As Integer
Dim j As Integer
'Application.OnTime Now() + TimeValue("00:00:1"), "RandomName"
On Error Resume Next
With Worksheets("ÃËÑʵÑÇàÅ¢")
    j = .Range("A65536").End(xlUp).Row - 1
    i = Int(Rnd * (j - 1) + 1)
    Set r = .Cells(i, 1)
End With
    r.Copy
With Worksheets("áÊ´§¼Å")
    .Range("D3").PasteSpecial xlPasteValues
    .Shapes("Button 12").Visible = True
End With
     Application.CutCopyMode = False
End Sub

Sub KeepVal()
Dim rs As Range
Dim rt As Range
On Error Resume Next
With Worksheets("áÊ´§¼Å")
    Set rs = .Range("D3")
    If .Range("Q7") = "" Then
        Set rt = .Range("Q7")
    Else
        Set rt = .Range("Q65536").End(xlUp).Offset(1, 0)
    End If
    rs.Copy
    rt.PasteSpecial xlPasteValues
    rt.Offset(0, -1) = rt.Offset(-1, -1) + 1
    Application.CutCopyMode = False
    r.EntireRow.Delete
    rs.Select
End With
    Worksheets("áÊ´§¼Å").Shapes("Button 12").Visible = False
End Sub