Excel Forum

ผมอ่านบทความวิธีการสุ่มโดยไม่เอาค่าซ้ำอย่างง่ายของอาจารย์สันติพงษ์ โดยใช้สูตรดังนี้
Cell B2 ใส่
=rand()
Cell C2 ใส่
=rank(b2,$B$2:$B$20)
Cell D2 ใส่
=index($A$2:$A$20,MATCH(ROWS($D$2:D2),$C$2:$C$20,0))

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

ขอบคุณครับ
เล็ก

ส่งไฟล์ตัวอย่างมาด้วยครับ การทำเช่นนั้นคิดว่าต้องใช้ VBA ครับ ยกเว้นจะสุ่มขึ้นมาทั้งหมดทีเดียวแบบไม่ซ้ำถึงจะสามารถใช้สูตรในการจัดการได้ครับ

เรียนอาจารย์ครับ
ผมส่งไฟล์มาให้ด้วยแล้วครับ

ขอบคุณครับ
เล็ก

ลองตามไฟล์แนบครับ

วิธีการใช้งาน
1. Copy รายชื่อที่ต้องการสุ่มมาวางที่ Sheet1
2. คลิกปุ่ม Random ที่ชีทแสดงผล โปรแกรมจะแสดงปุ่ม Keep Value มาให้
3. หากต้องการเก็บค่าที่ Random แล้วให้คลิกปุ่ม Keep Value โปรแกรมจะนำค่าที่สุ่มแล้วมาเรียงให้ โดยจะไม่นำค่าที่เก็บไว้นี้มาสุ่มใหม่อีก

Code การสุ่มและการเก็บค่า

ขอบคุณอาจารย์มากครับ
โอเคเลยครับผม
เล็ก
อาจารย์ ครับ ไม่ทราบว่าผมจะเรียนถามเรื่อง Power point ได้ด้วยหรือไม่ครับ

ขอบคุณอีกครั้งครับ

สามารถสอบถามที่หมวด Talk ได้เลยครับ

ผมเอาไปลองใช้ กดปุ่ม Random แล้วได้ป้ายนี้ ทำไงดีครับ

ดูการกำหนดค่า Macro ใหม่ว่ามีการกำหนดค่าไว้อย่างไรโดยเข้าเมนู Tools > Macro > Security > กำหนดเป็น Medium หรือ Low กรณีกำหนดเป็น Medium จะต้องคลิกให้ยอมรับการใช้งาน Macro ทุกครั้ง

จากนั้นปิดไฟล์นั้นไปก่อนแล้วเปิดขึ้นมาเพื่อทดสอบใหม่อีกรอบครับ

ขอบคุณครับ

ขอบคุณอาจารย์มากครับ ผมลองทำตามไฟล์แนบแล้วครับ
ใช้ได้ดีครับ แต่ติดอยู่นิดหน่อยครับ ตรงที่ถ้าเรากด Random จนเหลือคนสุดท้าย
แล้วถ้ากด Random อีกครั้ง มันจะขึ้น Debug ขึ้นมาครับ Error ตรง Set r = .Cells(i, 1)

แต่ไม่น่ามีปัญหาอะไร เพราะยังไงก็เหลือคนสุดท้ายไม่ต้องสุ่มเลือกกับใครอีก

snasui wrote:ลองตามไฟล์แนบครับ

วิธีการใช้งาน
1. Copy รายชื่อที่ต้องการสุ่มมาวางที่ Sheet1
2. คลิกปุ่ม Random ที่ชีทแสดงผล โปรแกรมจะแสดงปุ่ม Keep Value มาให้
3. หากต้องการเก็บค่าที่ Random แล้วให้คลิกปุ่ม Keep Value โปรแกรมจะนำค่าที่สุ่มแล้วมาเรียงให้ โดยจะไม่นำค่าที่เก็บไว้นี้มาสุ่มใหม่อีก

Code การสุ่มและการเก็บค่า

Code: Select all

Dim r As Range
Sub RandomName()
Dim i As Integer
Dim j As Integer
With Worksheets("Sheet1")
    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("D7").PasteSpecial xlPasteValues
    .Shapes("Button 12").Visible = True
End With
     Application.CutCopyMode = False
End Sub

Sub KeepVal()
Dim rs As Range
Dim rt As Range
With Worksheets("แสดงผล")
    Set rs = .Range("D7")
    If .Range("G7") = "" Then
        Set rt = .Range("G7")
    Else
        Set rt = .Range("G65536").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

มีวิธีแก้แบบง่าย ๆ โดยการแทรก on error resume next ใต้บรรทัด dim j as integer ครับ

ขอบคุณมากครับ หาอยู่เลย

ไฟล์นี้ผมเขียนไว้นานแล้ว, ลองดูนะครับว่าใช้วิธีการอะไรบ้าง
แต่โดยคร่าว ๆ คือ การใช้ Rand() เพื่อเรียงลำดับคนที่จะได้รางวัล
ใครอยู่อันดับแรกก็จะได้ไป , และรางวัลจะเรียงแบบ เล็ก ไปหา ใหญ่

ซึ้งขอบคุณครับ

ขอบคุณครับ

ขอบคุณมากครับ

ขอบคุณนะคะ