ให้ Excel สุ่มตัวเลขแบบไม่ซ้ำ

วันนี้จะมาเขียน Code VBA สำหรับการ สุ่มตัวเลขแบบไม่ซ้ำกันนะครับ

โดยหลักการก็จะประมานนี้

คือเราจะทำการสุ่มตัวเลขและชี้ไปที่ index ใน array จากนั้นจัดเรียง Array ใหม่ โดยตัดตัวเลขที่สุ่มแล้วออกไปจึงค่อย ทำการสุ่มอีกครั้ง

เริ่มต้นโดยจัดวาง Control ตามนี้เลยครับ

ให้ทำการ Double click ที่ Command button จากนั้นให้เอา Code ด้านล่างนี้ไปวาง

มาดู Code กัน

‘ก่อนอื่นก็ประกาศตัวแปรที่จะใช้กันก่อน

Dim ResN() As Integer   ‘ตัวแปรเก็บค่าตัวเลขทั้งหมด

Dim locN As Integer    ‘ตัวแปรชี้ตำแหน่งใน Array

Dim countArray As Integer   ‘ตัวแปรนับจำนวน Array ที่เหลืออยู่

Dim seRow As Integer     ‘ตัวแปรเก็บแถวที่ได้ทำการเลือก (Selection)

Dim seCol As Integer      ‘ตัวแปรเก็บคอลัมน์ที่ได้ทำการเลือก (Selection)

Dim pRow As Integer     ‘ตัวแปรเก็บ Pointer แถว ที่กำลังป้อนข้อมูลอยู่

Dim pCol As Integer    ‘ตัวแปรเก็บ Pointer คอลัมน์ ที่กำลังป้อนข้อมูลอยู่

Dim tRow As Integer    ‘ตัวแปรเก็บแถวภายใน selection

Dim tCol As Integer   ‘ตัวแปรเก็บคอลัมน์ภายใน selection

Sub RandNoDu()

‘กำหนดจำนวนข้อมูลใน array ใหม่

ReDim ResN(countArray) 

‘กำหนดค่าเริ่มต้น

tRow = 0

tCol = 0

'ใส่ค่าเข้าไปใน Array ก่อน ตามจำนวนทั้งหมดที่ได้เลือกไว้

For i = 0 To countArray

ResN(i) = i + 1

Next

'ทำการสุ่มตามจำนวน array ทั้งหมด

NextRand:

locN = Round((Rnd() * countArray), 0)

'แทรกข้อมูล

Cells(pRow + tRow, pCol + tCol).Value = ResN(locN)

tCol = tCol + 1

If tCol = seCol Then    ‘กรณีคอลัมน์เท่ากับจำนวนคอลัมน์ที่เราได้เลือกไว้ ให้ทำการขึ้นบรรทัดใหม่

tRow = tRow + 1

tCol = 0

End If

‘เรียกโปรแกรมย่อยเพื่อปรับค่า Array ใหม่

Call reSetArray

If countArray > -1 Then GoTo NextRand

End Sub

Sub reSetArray()

‘ตรวจสอบกรณีเหลือข้อมูลเดียว

If locN = 0 And countArray = 0 Then countArray = -1: Exit Sub

‘ตรวจสอบกรณีสุ่มได้หมายเลขสุดท้าย

If locN = countArray Then: countArray = countArray - 1: ReDim Preserve ResN(countArray): Exit Sub

‘นำข้อมูลที่ได้เลือกแล้วออกไป

For i = locN To countArray - 1

ResN(i) = ResN(i + 1)

Next

countArray = countArray – 1

‘ปรับจำนวน Array ใหม่ (ใช้ Preserve เพื่อให้ข้อมูล array เดิมยังอยู่)

ReDim Preserve ResN(countArray)

End Sub

Private Sub CommandButton1_Click()

‘กำหนดค่าเริ่มต้นต่าง ๆ

seRow = Selection.Rows.Count

seCol = Selection.Columns.Count

countArray = Selection.Count - 1

pRow = Selection.Row

pCol = Selection.Column

‘เรียกโปรแกรมย่อย

Call RandNoDu

End Sub

จากนั้นมาทำการทดสอบ Code กัน โดยการเลือก Range ที่ต้องการสุ่มตัวเลข จากนั้นก็กดปุ่ม “สุ่มตัวเลข” แล้วดูผลลัพธ์

ก็เสร็จสิ้นกันไปนะครับสำหรับการสุ่มตัวเลข แบบไม่ซ้ำ ลองเอาไปประยุกต์กันดูครับ