Random name

[Ponpimon]

Set gt = Range(grpAll.Offset(1, gc - 1), grpAll.Offset(1, gc - 1) _
.End(xlDown)).Resize(, 1)

อาจารย์คะ มันขึ้น debug สองบรรทัดนี้ค่ะ

[snasui]

นำ Code มาไว้ใน Module ข้างนอกครับ หากวางภายใน Sheet3 ต้องระบุ Parent ให้กับ Code ด้วยเป็นด้านล่างครับ

Code: Select all

Set gt = Sheets("Sheet2").Range(grpAll.Offset(1, gc - 1), grpAll.Offset(1, gc - 1) _
    .End(xlDown)).Resize(, 1)

[Ponpimon]

ได้แล้วค่ะอาจารย์ ขอบคุณมาค่ะ ^^

[Ponpimon]

อาจารย์คะ ยังมีบางครั้งที่กรรรมการ1กับกรรมการ2 เป็นชื่อที่ซ้ำกับอาจารย์ที่ปรึกษาและอาจารย์ที่ปรึกษาร่วมค่ะ

[snasui]

Clear ชื่อทั้งหลายให้เหมือนกันทุกประการเสียก่อน เช่นมีวรรคตามหลังบ้าง ไม่มีวรรคตามหลังบ้างก็ให้ลบวรรคตามหลังออกให้หมด เพราะการมีวรรคกับไม่มีวรรคโปรแกรมจะมองว่าเป็นคนละค่ากันครับ

ยกตัวอย่างเซลล์ B6 กับ C3 ใน Sheet2 ชื่อเมย์ จะมีวรรรคตามหลัง ส่วน F2:J6 คำว่าเมย์ ไม่มีวรรคตามหลัง

[Ponpimon]

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

[snasui]

ควรแก้มาเองก่อนเสมอแล้วถามเฉพาะที่ติดปัญหาครับ

[Ponpimon]

gc = Application.Match(pck.Offset(0, 1), grpAll, 0)

อาจารย์คะ ตอนนี้มันจะรันแค่รอบเดียวค่ะ แล้วจะเด้ง debug ขึ้นมาที่บรรทัดนี้ค่ะ เกิดจากอะไรคะ

[snasui]

เพราะไม่มีตัวแปร pck.Offset(0, 1) ในตัวแปร grpAll หรือแปลอีกอย่างหนึ่งคือไม่พบ pck.Offset(0, 1) ใน grpAll จึงเกิด Error

ควรทำความเข้าใจในแต่ละตัวแปรว่าคืออะไรจะได้ตรวจสอบเองได้ครับ

[Ponpimon]

อาจารย์คะ วันนี้หนูเอาโค้ดสุ่มโค้ดเดิมที่อาจารย์เคยเแนะนำให้มาถามอีกค่ะ คือหนูเพิ่มเงื่อนไขภาระงานเข้าไป คือ อาจารย์1คนจะทำงานได้ไม่เกินภาระที่กำหนด เช่น ถ้าอาจารย์คนที่1 เป็นอาจารย์ที่ปรึกษา2กลุ่ม แล้วกำหนดภาระงานเท่ากับ 3 แสดงว่าอาจารย์คนนี้จะเป็นกรรมการสอบได้แค่ 1 กลุ่มเท่านั้น แล้วหนูได้นำเอาข้อมูลของภาระงานไปสุ่ม ถ้าสุ่มจำนวนกลุ่มน้อยๆ จะไม่เป็นปัญหา แต่พอมีจำนวนกลุ่มมากขึ้น ประมาณ30กลุ่ม จะค้างค่ะ จะแก้ไขตรงส่วนไหนคะ

[snasui]

ช่วยไปรายงานผลหรือแจ้งความคืบหน้าของกระทู้ด้านล่างก่อนครับ

viewtopic.php?f=3&t=8175
viewtopic.php?f=3&t=8197
viewtopic.php?f=3&t=8316
viewtopic.php?f=3&t=8329
viewtopic.php?f=3&t=8330

[Ponpimon]

รายงานผลเรียบร้อยแล้วค่ะ ขอโทษด้วยนะคะที่ไม่ได้รายงานผลค่ะ^^

[snasui]

จากที่ถามมาช่วยแสดง Code ที่ได้ปรับเองมาแล้วด้วย จะได้เห็นว่าได้ปรับส่วนใด ปรับอย่างไร เป็นเบื้องต้นครับ

[Ponpimon]

Code: Select all

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
On Error GoTo ErrorHandler
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("B13", .Range("B" & .Rows.Count).End(xlUp))
    End With
    For Each pck In paCheck

        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)))
                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
ErrorHandler:
Application.ScreenUpdating = True
End Sub

[snasui]

ดูเหมือนจะเป็น Code ที่เคยถามตอบกันมาเท่านั้น บรรทัดไหนที่ปรับมาเองแล้วครับ การเปลี่ยนชื่อชีทผมไม่ถือว่าปรับครับ

[Ponpimon]

ก็มีเพิ่ม On Error GoTo ErrorHandler เข้ามาค่ะ
แล้วก็เปลี่ยนที่มาขอsheet เชี่ยวชาญ คือ มันน่าจะมีปัญหาตรง sheet ภาระงาน ที่สามารถปรับเปลี่ยนได้ พอปรับได้แล้ว ถ้ามีภาระงานน้อยๆ กรรมการที่จะมีสิทธิ์มาสุ่มได้ก็จะน้อยลง แล้วทำให้โค้ดสุ่มหาอาจารย์ไม่เจอ เพราะว่าจำนวนกลุ่มเยอะ อาจารย์ไม่พอกับกลุ่มที่มีเยอะ เลยค้างค่ะ หนูเลยไม่รู้จะแก้ตรงจุดไหนค่ะ คือหนูอยากให้สุ่มเท่าที่มีค่ะ แล้วหยุดทำงานเลย ไม่อยากให้ค้างค่ะ

[snasui]

การดัก Error เข้าใจว่าได้ถามตอบไปแล้วเช่นกันครับ

ที่ Code วัน Loop ไม่รู้จบเพราะว่าต้องกรอกค่าให้ครบคอลัมน์ D:E ในชีท ตารางสอบ ทั้ง 2 คอลัมน์ ซึงหากพบว่าตรงกันทั้งหมดหรือตรงกันแต่ 1 คนก็ไม่มีทางที่จะกรอกได้ครบทั้ง 2 คอลัมน์ Code จึงวนไม่รู้จบ นอกจากนี้มีการกำหนดตัวแปรไม่ถูกต้องเข้ามาด้วย ตัวอย่างการปรับ Code ตามด้านล่างครับ

Code: Select all

'Other code

With Sheets("เชี่ยวชาญ")
    Set grpAll = .Range("D4", .Range("D4").End(xlToRight))
End With

'Other code

For Each g In gt
    If Application.CountIf(cmAll, g) = 0 And g <> "-" 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 < iCount And i <= 1
        x = gSl(Int(Rnd * (UBound(gSl) + 1)))
        If InStr(t, x) = 0 Then
            t = t & x
            c.Offset(0, i) = x
            i = i + 1
        End If
    Loop
Next c

'Other code

บรรทัดที่เขียนว่า Other code คือ Code ชุดที่มีอยู่เดิมไม่ได้ปรับปรุงใด ๆ

[Ponpimon]

Code: Select all

gc = Application.Match(pck.Offset(0, 1), grpAll, 0)

อาจารย์คะ มันติดdebugบรรทัดเดิมค่ะ หนูต้องแก้ไขยังไงคะ

[snasui]

ในเครื่องผมไม่ติดปัญหา ควรแนบไฟล์ที่ปรับ Code แล้วมาดูด้วยว่าตรงกับที่ให้ปรับไปหรือไม่ครับ

[Ponpimon]

ค่ะ ตอนนี้ใช้งานได้ปกติแล้วค่ะอาจารย์ ขอบคุณมากค่ะ^^