Private Sub CommandButton1_Click()
Dim prjs As Range, prj As Range, pjl As Integer
Dim pa As Range, paCheck As Range, pck As Range
Dim cmAll As Range, cm As Range, cmr As Range, c As Range
Dim grpAll As Range, gSl() As Variant, gc As Long
Dim gt As Range, g As Range, iCount As Integer, i As Integer
Dim ig As Integer, t As String, x As String
With Sheets("ข้อมูลอาจารย์")
Set grpAll = .Range("D38", .Range("D38").End(xlToRight))
End With
With Sheets("Sheet2")
Set pa = .Range("B2", .Range("B" & .Rows.Count).End(xlUp))
End With
With Sheets("ตารางสอบ")
Set paCheck = .Range("B10", .Range("B" & .Rows.Count).End(xlUp))
End With
For Each pck In paCheck
On Error Resume Next
If pck <> "" Then
pjl = Application.Match(pck, pa, 0)
Set cmAll = pa.Offset(pjl - 1, 1).Resize(1, 2)
gc = Application.Match(pck.Offset(0, 1), grpAll, 0)
Set gt = Sheets("ข้อมูลอาจารย์").Range(grpAll.Offset(1, gc - 1), grpAll.Offset(1, gc - 1) _
.End(xlDown)).Resize(, 1)
iCount = 0
For Each g In gt
If Application.CountIf(cmAll, g) = 0 Then
ReDim Preserve gSl(iCount)
gSl(iCount) = g
iCount = iCount + 1
End If
Next g
Set cmr = pck.Offset(0, 2).Resize(1, 2)
t = "-"
i = 0
For Each c In cmr
Do While i <= 1
x = gSl(Int(Rnd * (UBound(gSl) + 1)))
'MsgBox "x=" & x
If InStr(t, x) = 0 Then
t = t & x
c.Offset(0, i) = x
i = i + 1
End If
Loop
Next c
End If
Next pck
UserForm10.Hide
End Sub
ก็ต้องมีอย่างน้อย 2 ลำดับครับ