การสุ่มแบบคัดออก

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

โดยมีวิธีการคือ

1. เตรียมชีทรายชื่อที่ต้องการสุ่มสมมุติชื่อชีท Names โดยเก็บข้อมูลที่ต้องการสุ่มไว้ในคอลัมน์ A
2. เตรียมชีทที่ใช้ในการแสดงผลการสุ่มและเก็บข้อมูลของคนที่ถูกสุ่มแล้วแยกไว้ต่างหาก สมมุติชื่อชีท Random
3. เขียน Code VBA เพื่อทำการสุ่มข้อมูลและเก็บข้อมูลที่ได้จากการสุ่มตามด้านล่าง
4. สร้างปุ่มเพื่อคลิกสุ่มข้อมูลและเก็บข้อมูล โดยให้ชื่อปุ่ม Random และ Keep Value ตามลำดับ
5. ทำการ Assigned Macro ที่ชื่อ RandomName ให้กับปุ่ม Random และ Assigned Macro ที่ชื่อ KeepVal ให้กับปุ่ม Keep Value ตามลำดับ

Code VBA สำหรับการสุ่มข้อมูล

Dim r As Range
Sub RandomName()
    Dim i As Integer, j As Integer
    With Worksheets("Names")
        j = .Range("A65536").End(xlUp).Row - 1
        i = Int(Rnd * (j - 1) + 1)
        Set r = .Cells(i, 1)
    End With
    With Worksheets("Random")
        .Range("D7") = r
        .Shapes("Button 12").Visible = True
    End With
End Sub

Sub KeepVal()
    Dim rs As Range, rt As Range
    With Worksheets("Random")
        Set rs = .Range("D7")
        If .Range("G7") = "" Then
            Set rt = .Range("G7")
        Else
            Set rt = .Range("G65536").End(xlUp).Offset(1, 0)
        End If
        rt = rs
        rt.Offset(0, -1) = rt.Offset(-1, -1) + 1
        r.EntireRow.Delete
        .Shapes("Button 12").Visible = False
    End With
End Sub

ภาพตัวอย่างการสุ่มข้อมูล

จากภาพด้านบนจะเห็นว่าเมื่อคลิกปุ่ม Random แล้วจะทำการสุ่มข้อมูลมาให้ที่ D7 และจะมีปุ่ม Keep Value ปรากฏขึ้นมาเพื่อเตรียมพร้อมสำหรับการเก็บข้อมูลไว้ที่ F7:G7 เป็นต้นไป เมื่อคลิกปุ่ม Keep Value ก็จะทำการเก็บข้อมูลที่สุ่มมาแล้ว จากนั้นจะทำการซ่อนปุ่มนี้ไว้ และจะปรากฏอีกทีเมื่อคลิกปุ่ม Random

สำหรับสมาชิกเวบ http://www.snasui.com/ สามารถดาวน์โหลดไฟล์ตัวอย่างได้จากที่นี่ครับ Random and keep value

การสุ่มโดยไม่เอาค่าซ้ำแบบ Advanced

เราทราบการสุ่มจากค่าทั้งหมดโดยไม่เอาค่าที่ซ้ำ จากหัวข้อการสุ่มโดยไม่เอาค่าซ้ำอย่างง่ายมาแล้ว ในหัวข้อนี้มาดูการสุ่มค่าจากค่าทั้งหมดโดยไม่เอาค่าที่ซ้ำแบบ Advanced กันบ้าง

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

สมมุติต้องการสุ่มรายชื่อจาก A2:A11 มา 3 รายชื่อ

ที่ B2 คีย์

=INDEX($A$2:$A$11,SMALL(IF(COUNTIF($B$1:B1,$A$2:$A$11)=0,ROW($A$2:$A$11)-ROW($A$2)+1),INT(RAND()*ROWS(A2:$A$11)+1)))

Ctrl+Shift+Enter > Copy ไปถึง B4 ก็จะได้ 3 ค่าที่ไม่ซ้ำจากค่าทั้งหมดตามที่ต้องการ ลองกดแป้น F9 สังเกตการเปลี่ยนแปลง

ภาพตัวอย่างการสุ่มโดยไม่เอาค่าซ้ำแบบ Advanced

การสุ่มข้อมูลที่ไม่ซ้ำกันเป็นชุด ๆ (VBA)

การสุ่มข้อมูลเป็นชุด ๆ ด้วยสูตรสามารถดูได้ที่นี่ครับ ด้านล่างนี้จะแสดงตัวอย่างการเขียน Code ให้สุ่มข้อมูลออกมาเป็นชุด ๆ ในแต่ละชุดไม่ซ้ำกัน โดยเรียกใช้ Proceture RandomUnique

ภาพตัวอย่าง

Option Explicit

Sub TestUnique()
    Dim a() As Variant, b() As Variant
    Dim i As Integer, j As Integer
    Dim k As Integer, l As Integer
    l = 4 'Random 1-4
    For i = 1 To l
        ReDim Preserve a(i)
        a(i) = i
    Next i
    For i = 1 To l
        ReDim Preserve b(i)
        Do
            j = a(Int(Rnd() * l + 1))
            On Error Resume Next
            k = Application.Match(j, b, 0)
        Loop Until Err = 13
        On Error GoTo 0
        b(i) = j
    Next i
    For i = 1 To l
        If Selection.Cells(i, 1).Offset(0, -1) = "" Then Exit For
        Selection.Cells(i, 1) = b(i)
    Next i
End Sub

Sub RandomUnique()
    Do
        TestUnique
        Selection.Cells(500, 1).End(xlUp).Offset(1, 0).Activate
    Loop Until Selection.Offset(0, -1) = ""
End Sub 

 

การใช้สูตรสุ่มข้อมูลเป็นชุด ๆ โดยกำหนดได้ว่าให้ไม่ซ้ำกันภายในชุด

เหตุการณ์ของการสุ่มอย่างที่ว่านี้คือ สุ่มออกมาเป็นชุด ๆ โดยให้ข้อมูลไม่ซ้ำกันภายในชุดนั้นใช้ในกรณีไหนบ้าง ตัวอย่างที่เห็นได้ชัดก็เรื่องของการจัดกลุ่มแข่งขันกีฬาสีครับ

เป็นที่น่าดีใจว่า Excel เองสามารถที่จะสุ่มเช่นนี้ด้วยสูตรได้เหมือนกัน โดยไม่ต้องพึ่งพา VBA แต่สูตรยาวพอควร เข้าใจค่อนข้างยาก แต่นั่นไม่ใช่ปัญหาสำหรับเราใช่ไหมครับ

ภาพตัวอย่างการ Random ด้วยสูตรตามด้านล่างครับ

 

จากภาพด้านบนเราสมมุติว่าข้อมูลมีชุดละ 2 บรรทัด และโดยชุดแรกคือ C2:C3, ชุดที่สองคือ C4:C5 เป็นต้น และจะทำการสุ่มโดยนำข้อมูลสีที่ E3:E4 เข้าแสดงแต่ต้องไม่ซ้ำสีกันภายในชุดเดียวกัน

เซลล์ E3:E4  สามารถกรอกค่าใด ๆ ก็ได้ไม่จำเป็นต้องเป็นต้วหนังสือ และจะกรอกกี่ค่าก็ได้ แต่ถ้ากรอกมากกว่า 2 ค่าตามที่ยกตัวอย่างมา จะต้องเข้าไปแก้สูตรใหม่ โดยเปลี่ยนเลข 2 ที่ไม่เกี่ยวกับช่วงเซลล์ ให้เป็นเลขใด ๆ ตามจำนวนค่าจริงที่ต้องการสุ่ม และแก้ไขช่วงเซลล์ที่ต้องการสุ่ม

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

ช่วงเซลล์ที่ต้องการสุ่มในฟังก์ชั่น Index ก็เช่นกัน สามารถทำให้ Dynamic โดยการให้ชื่อกับช่วงเซลล์แบบ Dynamic ได้

ตามรูป ที่ C2 คีย์

=Index($E$3:$E$4,Small(If(Countif(If(Mod(Rows($C$2:C2)-1,2)=0,$C$1:$C$1,Offset(C1,0,0,-Mod(Rows($C$2:C2)-1,2),1):C1),$E$3:$E$4)=0,Row($E$3:$E$4)-Row($E$3)+1),Int((2-Mod(Rows($C$2:C2)-1,2))*Rand())+1))

การกดแป้นให้รับสูตรต้องกด 3 แป้นคือ Ctrl+Shift+Enter ถ้ากดแป้นถูกต้องจะเห็นปีกกาคร่อมสูตร จากนั้น Copy ลงด้านล่าง

การสุ่มโดยไม่เอาค่าซ้ำอย่างง่าย

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

สมมุติมีรายชื่อตั้งแต่ A2:A20 และเราต้องการเลือกมา 10 ชื่อโดยไม่ให้ซ้ำ ให้ผลลัพธ์อยู่ในเซลล์ D2:D11 สามารถทำได้ดังนี้

1. ที่ B2 คีย์

=Rand() > Copy ลงไปถึง B20

2. ที่ C2 คีย์

=Rank(B2,$B$2:$B$20) > Copy ลงไปถึง C20

3. ที่ D2 คีย์

=Index($A$2:$A$20,Match(Rows($D$2:D2),$C$2:$C$20,0))

Enter > Copy ลงไปด้านล่างถึง D11

ลองกดแป้น F9 สังเกตการเปลี่ยนแปลง