- ถ้าไม่ลงตัว มีเศษ จะตั้งกลุ่มใหม่ หรือใส่กลุ่มอื่นเป็น 5 คน
- แล้วถ้าการสุ่มเกิดย้ายคนจากกลุ่ม A เป็น B เหมือนกันทั้ง 4 คน (เพราะมันเป็นการสุ่มย่อมเกิดขึ้นได้) เงื่อนไขนี้รับได้ป่าวครับ

- ถ้าไม่ลงตัว มีเศษ จะตั้งกลุ่มใหม่ หรือใส่กลุ่มอื่นเป็น 5 คน

   // เศษตั้งกลุ่มใหม่ครับ


- แล้วถ้าการสุ่มเกิดย้ายคนจากกลุ่ม A เป็น B เหมือนกันทั้ง 4 คน (เพราะมันเป็นการสุ่มย่อมเกิดขึ้นได้) เงื่อนไขนี้รับได้ป่าวครับ

// คนที่อยู่ในกลุ่มเดียวกันก่อนหน้านี้ เมื่อไปจัดกลุ่มใหม่ อยากให้ไปแค่คนเดียว ครับ

// คนที่อยู่ในกลุ่มเดียวกันก่อนหน้านี้ เมื่อไปจัดกลุ่มใหม่ อยากให้ไปแค่คนเดียว ครับ

เงื่อนไขนี้แสดงว่าหากมี 1 กลุ่ม มี 4 คนในตัวอย่าง กลุ่มจะต้องมี 5 กลุ่ม น้อยกว่านี้จะต้องมีคนในกลุ่มเดียวกันมาก่อนเจอกันที่กลุ่มใหม่นะครับ

เงื่อนไขยากจัง แต่ก็น่าคิดอยู่ ไว้จะค่อยๆคิดนะครับ ไม่รับปากนะครับ เพราะมีอะไรหลายอย่างต้องทำอยู่เหมือนกัน

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

มีตรรกะที่แน่นอน อย่างที่คุณ TTT ว่าอยู่ แต่ผมยังคิดไม่ออกครับ ไว้คุณ TTT ว่างก่อนก็ได้ครับ

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

มาตอบคำถามนะครับ

- คือตามโจทย์ที่ให้มา ต้องปรับให้คนในกลุ่มเก่ามีแค่ 4 คน ก่อนนะครับถึงใช้สูตรนี้ได้ (โจทย์ที่ให้มามีกลุ่ม C, D มี 5 คน)


- หากจำนวนคนมีเท่ากับหรือมากกว่า สูตร (จำนวนคนในกลุ่ม ^ 2) + จำนวนคนในกลุ่ม จะสามารถเปลี่ยนกลุ่มทุกคนโดยไปกลุ่มใหม่แบบไม่ซ้ำกันตามเงื่อนไขได้

- หากจำนวนคนมีเท่ากับหรือมากกว่า สูตร (จำนวนคนในกลุ่ม ^ 2) แต่ไม่เกิน (จำนวนคนในกลุ่ม ^ 2) + จำนวนคนในกลุ่ม ในแต่ละกลุ่มจะมีคนอยู่กลุ่มเดิม 1 คน แต่คนที่เข้ามาใหม่ในกลุ่มจะไม่ซ้ำกัน

- หากมีจำนวนน้อยกว่า(จำนวนคนในกลุ่ม ^ 2) จะต้องมีคนอยู่กลุ่มเดียวกันซ้ำกันในกลุ่มใหม่

-----------------------------------------------------------------------------------
Sub Switch_Group()
    Const perGroup As Integer = 4 'แบ่งกลุ่มละกี่คน
    Const TableName As String = "Table1" 'ชื่อตารางเป้าหมาย
    Const Field_OldGroup As String = "Old_Group" 'ชื่อฟิลด์เก็บชื่อกลุ่มเดิมที่เคยอยู่
    Const Field_NewGroup As String = "New_Group" 'ชื่อฟิลด์เก็บชื่อกลุ่มใหม่ที่จะย้าย
    
    Dim iMax As Long, iGroup As Integer, lastGroup As Integer, lastNGroup As Integer
    Dim iLoop As Integer, iNewName As String, chrName As Integer, chrGroup As Integer, ExitLoop As Integer
    
    iMax = DCount("1", TableName) 'iMax = เก็บค่าจำนวนคนทั้งหมด
    lastGroup = iMax Mod perGroup
    lastNGroup = iMax Mod perGroup
    iGroup = IIf(iMax Mod perGroup = 0, iMax \ perGroup, (iMax \ perGroup) + 1) 'iGroup = เก็บค่าจำนวนกลุ่มทั้งหมด โดยถ้ามีเศษจะปัดขึ้นเป็นอีก 1 กลุ่ม
'****************************************************************************************************    
    If iMax >= (perGroup ^ 2) And iMax < (perGroup ^ 2) + perGroup Then
        MsgBox "จะมี 1 คนอยู่กลุ่มเดิม แต่ทุกคนในกลุ่มจะมาจากกลุ่มอื่นที่ไม่ซ้ำกัน", , "1 คนอยู่กลุ่มเดิม"
    ElseIf iMax < (perGroup ^ 2) Then
        MsgBox "การแบ่งกลุ่มต้องมีซ้ำ เนื่องจากจำนวนต้องมีค่าไม่น้อยกว่า " & perGroup ^ 2 + perGroup & " การแบ่งกลุ่มถึงจะไม่ซ้ำกัน", , "คนในกลุ่มซ้ำกัน"
    End If
    
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM " & TableName & " ORDER BY " & Field_OldGroup)
'****************************************************************************************************
    rs.MoveFirst
    Do Until rs.EOF
        rs.Edit
        rs(Field_NewGroup) = Null
        rs.Update
        rs.MoveNext
    Loop
'****************************************************************************************************
    For iLoop = 1 To iGroup
        chrGroup = 1
        rs.MoveFirst
        Do Until rs.EOF
            If rs(Field_OldGroup) = Chr(64 + chrGroup) And IsNull(rs(Field_NewGroup)) Then 'กรองเฉพาะในส่วนของชื่อกลุ่ม ในฐานข้อมูล ให้เข้ามาแบบเรียง ABCD... เพื่อเราจะได้ตำแหน่ง rs(Field_OldGroup) ตามที่เราต้องการไว้ Update เทียบกับช่อง rs(Field_NewGroup) ต่อไป
               If iMax Mod perGroup = 0 Then
                    chrGroup = IIf(chrGroup = iGroup, 1, chrGroup + 1) 'เมื่อรันเลขครบตามจำนวนสูงสุดของกลุ่ม ให้กลับไปเริ่ม 1 ใหม่
                    'Debug.Print rs(Field_OldGroup)
               Else
                    'Debug.Print rs(Field_OldGroup)
                    'เมื่อรันเลขครบตามจำนวนสูงสุดของกลุ่ม ให้กลับไปเริ่ม 1 ใหม่
                    chrGroup = IIf(lastGroup > 0, IIf(chrGroup = iGroup, 1, chrGroup + 1), IIf(chrGroup = iGroup - 1, 1, chrGroup + 1))
                    If rs(Field_OldGroup) = Chr(64 + iGroup) Then 'แต่ถ้ามีเศษของกลุ่มเกิน ให้ตัดกลุ่มนั้นออกเมื่อครบตามจำนวนเศษที่เกิน
                        lastGroup = lastGroup - 1
                    End If
               End If
'****************************************************************************************************
               Do
                    ExitLoop = ExitLoop + 1
                    If iMax Mod perGroup = 0 Then
                        chrName = IIf(chrName > iGroup - 1, 1, chrName + 1)
                    Else
                        chrName = IIf(lastNGroup > 0, IIf(chrName > iGroup - 1, 1, chrName + 1), IIf(chrName > iGroup - 2, 1, chrName + 1))
                        If chrName = iGroup Then
                            lastNGroup = lastNGroup - 1
                        End If
                    End If
                    iNewName = Chr(64 + chrName)
                    If ExitLoop > iGroup Then Exit For
               Loop While rs(Field_OldGroup) = iNewName Or DCount("1", TableName, Field_NewGroup & " = '" & iNewName & "' AND " & Field_OldGroup & " = '" & rs(Field_OldGroup) & "'") > 0
'****************************************************************************************************
               rs.Edit
               rs(Field_NewGroup) = iNewName
               rs.Update
               ExitLoop = 0
            End If
            rs.MoveNext
        Loop
    Next
'****************************************************************************************************
    If iMax < (perGroup ^ 2) + perGroup Then 'เฉพาะจำนวนที่มีเศษ
        lastNGroup = iMax Mod perGroup 'กำหนดค่าตัวแปรใหม่เป็นค่าเดิม เพื่อใช้ใหม่อีกครั้ง
        lastGroup = iMax Mod perGroup 'กำหนดค่าตัวแปรใหม่เป็นค่าเดิม เพื่อใช้ใหม่อีกครั้ง
        chrName = 0
        For iLoop = 1 To perGroup
            chrGroup = 1
            rs.MoveFirst
            Do Until rs.EOF
               If rs(Field_OldGroup) = Chr(64 + chrGroup) And IsNull(rs(Field_NewGroup)) Then 'กรองเฉพาะในส่วนของชื่อกลุ่ม ในฐานข้อมูล ให้เข้ามาแบบเรียง ABCD... เพื่อเราจะได้ตำแหน่ง rs(Field_OldGroup) ตามที่เราต้องการไว้ Update เทียบกับช่อง rs(Field_NewGroup) ต่อไป
                    If iMax Mod perGroup = 0 Then
                        chrGroup = IIf(chrGroup = iGroup, 1, chrGroup + 1) 'เมื่อรันเลขครบตามจำนวนสูงสุดของกลุ่ม ให้กลับไปเริ่ม 1 ใหม่
                    Else
                        'เมื่อรันเลขครบตามจำนวนสูงสุดของกลุ่ม ให้กลับไปเริ่ม 1 ใหม่
                        chrGroup = IIf(lastGroup > 0, IIf(chrGroup = iGroup, 1, chrGroup + 1), IIf(chrGroup = iGroup - 1, 1, chrGroup + 1))
                        If rs(Field_OldGroup) = Chr(64 + iGroup) Then 'แต่ถ้ามีเศษของกลุ่มเกิน ให้ตัดกลุ่มนั้นออกเมื่อครบตามจำนวนเศษที่เกิน
                            lastGroup = lastGroup - 1
                        End If
                    End If
'****************************************************************************************************
                    Do
                        If iMax Mod perGroup = 0 Then
                            chrName = IIf(chrName > iGroup - 1, 1, chrName + 1)
                        Else
                            chrName = IIf(lastNGroup > 0, IIf(chrName > iGroup - 1, 1, chrName + 1), IIf(chrName > iGroup - 2, 1, chrName + 1))
                            If chrName = iGroup Then
                                If DCount("1", TableName, "Change = '" & Chr(64 + iGroup) & "'") >= lastNGroup Then
                                    chrName = 1
                                Else
                                    lastNGroup = lastNGroup - 1
                                End If
                            End If
                        End If
                        iNewName = Chr(64 + chrName)
                    Loop While DCount("1", TableName, Field_NewGroup & " = '" & iNewName & "'") > perGroup - 1
                    rs.Edit
                    rs(Field_NewGroup) = iNewName
                    rs.Update
               End If
               rs.MoveNext
            Loop
        Next iLoop
    End If
    rs.Close: Set rs = Nothing
End Sub
----------------------------------------------------------------------------

ปล. ถ้าอยากดูแนวคิด คำอธิบายที่มา ดูได้
ที่นี่

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

ติดตามอ่าน ขอบคุณครับได้ความรู้หลักการคิดเข้าใจง่ายได้เห็นภาพ :)