การสุ่มข้อมูลที่ไม่ซ้ำกันเป็นชุด ๆ (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

Revised: January 28, 2017 at 16:33