VBA หาค่าสูงสุด

[aueijung]

เรียนอาจารย์ที่เคารพครับ
เหตุใดการแสดงผลลัพธ์จากการดึงข้อมูล ในการหาค่าสูงสุด แสดงผลลัพธ์ไม่ตรงกับค่าที่เป็นจริง กล่าวคือ หากคะแนนในไฟล์แต่ละไฟล์ของ directory = D:\data\ปีการศึกษา2559\เทอม2\ม.4-1 ชีท รายงาน1 cell i7:i61 ถ้าแถวใดมีค่ามากที่สุดให้แสดงผลออกมา แสดงชื่อวิชา, ชื่อ, นามสกุล, ชั้น, คะแนน โดยการกดปุ่ม ดึงคะแนน ที่ไฟล์ คะแนนสูงสุดแต่ละวิชา.xlsm ที่ชีท MaxM4 โดยมีเงื่อนไขว่า ถ้าคะแนนมากที่สุดของแต่ละวิชา ให้แสดงข้อมูลชื่อวิชา, ชื่อ, นามสกุล, ชั้น, คะแนน ของคนที่ได้คะแนนสูงสุด แต่ถ้าคะแนนมากสุด เท่ากันในแต่ละรายวิชา ก็ให้แสดงข้อมูลของคนที่ได้คะแนนสูงสุดที่เหมือนกัน เมื่อแสดงข้อมูลจนครบทุกไฟล์ใน directory = D:\data\ปีการศึกษา2559\เทอม2\ม.4-1 แล้ว ก็ให้ไปค้นหาข้อมูลของอีกห้องคือ directory = D:\data\ปีการศึกษา2559\เทอม2\ม.4-2 แสดงเหมือนกันกับห้องแรก แต่ว่าถ้าวิชาเหมือนกันก็ให้เอาชื่อวิชา, ชื่อ, นามสกุล, ชั้น, คะแนน ในวิชาที่เหมือนกัน เขียนต่อเป็นกลุ่มของรายวิชานั้นๆ เช่น วิชาคณิตศาสตร์ มีนักเรียนทั้ง 2 ห้องที่เรียนวิชานี้ หากมีคะแนนสูงสุด ห้อง ม.4/1 มีคะแนนสูงสุด 3 คนที่เท่ากัน ก็แสดงข้อมูลของทั้ง 3 คน จากนั้นก็ไปหาห้อง ม.4/2 มีใครที่มีคะแนนสูงสุดก็เอาข้อมูลมาเขียนต่อเป็นคนที่ 4 ตามลำดับ ถ้าห้อง ม.4/2 มีแค่คนเดียวที่มีคะแนนมากที่สุด แต่ถ้ามีคะแนนมากที่สุดหลายคนก็เอาข้อมูลมาต่อกันเหมือนของห้องแรก
ไม่รู้ว่าผมอธิบายปัญหาให้อาจารย์ได้เข้าใจได้ชัดเจนบ้างหรือเปล่า

[aueijung]

ตัวอย่างโค๊ด VBA หาค่าสูงสุดตามเงื่อนไขที่ติดปัญหาในการแสดงผลลัพธ์ที่ไม่ถูกต้องครับ

Code: Select all

Sub MaxM4_Click()
Dim directory As String, fileName As String
    Dim sheet As Worksheet, j, i, r, max, Min As Integer
    Dim tempBook As Workbook, thsBook As Workbook
    Dim bookStr As String, rw As Integer
    Application.ScreenUpdating = False
    directory = Sheets("MaxM4").Range("o2").Value
    fileName = Dir(directory & "*.xl??")
    Set thsBook = ThisWorkbook
    j = 3 
    
Do While fileName <> ""
    Set tempBook = Workbooks.Open(directory & fileName)
    bookStr = VBA.Left(tempBook.Name, 6)
    On Error Resume Next
    With thsBook.Sheets("MaxM4")
        rw = Application.Match(bookStr, .Range("r2:r10000"), 0) - 1
        If Err <> 0 Then
            MsgBox "File " & tempBook.Name & " ไม่พบไฟล์ใน column R."
            Err = 0
        Else
           .Cells(j, "a") = tempBook.Name
‘ให้แสดงคะแนนมากที่สุด  1 คนของรายวิชานั้น  แต่ถ้าคะแนนสูงสุดเท่ากัน  ก็ให้แสดงคนที่มีคะแนนสูงสุดเท่ากันในแต่ละวิชา  โดยแสดงชื่อวิชา  ชื่อ-นามสกุล  ระดับชั้น  ห้อง  และคะแนนสูงสุด ต่อกันลงมาเป็นแถวถัดไป  ที่ชีท MaxM4 เซลล์ a3:f10000
'i = 7
r = 7
'Min = 0
max = 100
Do Until tempBook.Sheets("รายงาน1").Range("i" & r) = ""
If tempBook.Sheets("รายงาน1").Range("i" & r) <= max Then .Cells(j, "f").Resize(1, 1).Value = _
                 tempBook.Sheets("รายงาน1").Range("i" & r).Value
             .Cells(j, "c").Resize(1, 1).Value = _
                 tempBook.Sheets("รายงาน1").Range("d" & r).Value
             .Cells(j, "d").Resize(1, 1).Value = _
                 tempBook.Sheets("รายงาน1").Range("e" & r).Value
            .Cells(j, "b").Resize(1, 1).Value = _
                 tempBook.Sheets("Home").Range("c12").Value
             .Cells(j, "g").Resize(1, 1).Value = _
                  tempBook.Sheets("Home").Range("c9").Value
             .Cells(j, "h").Resize(1, 1).Value = _
                  tempBook.Sheets("Home").Range("e9").Value
                  
r = r + 1
Loop

        End If
    End With
    j = j + 1
    tempBook.Close False
    fileName = Dir()
Loop
       
    Application.ScreenUpdating = True
    MsgBox ("รับไฟล์จาก Directory " & Sheets("MaxM4").Range("o2").Value & " เรียบร้อยแล้วค่ะ")

End Sub

โค๊ด VBA โมดูล11 ตามที่แจ้งครับอาจารย์
ในโมดูลดังกล่าว มีการจับคู่ในการเปิดไฟล์ ถ้าใน directory มีไฟล์ที่ match กับคอลัมน์ R ในชีท MaxM4 ไฟล์ คะแนนสูงสุดแต่ละวิชา.xlsm
สรุปปัญหาคือ
1.แสดงผลลัพธ์ที่ไม่ถูกต้อง ตามความเป็นจริงของข้อมูล
2.ไม่วนซ้ำไปค้นหาข้อมูลที่ directory ถัดไป
ครับอาจารย์

[pong2532]

โค๊ดครับ

Code: Select all

r = 7
Range(Range("i" & r), Range("i" & r).End(xlDown)).Select
max = Application.max(Sheets(ActiveSheet.Name).Range(Selection.Address))

Do Until tempBook.Sheets("ÃÒ§ҹ1").Range("i" & r) = ""
If tempBook.Sheets("ÃÒ§ҹ1").Range("i" & r) = max Then
             .Cells(j, "f").Resize(1, 1).Value = tempBook.Sheets("ÃÒ§ҹ1").Range("i" & r).Value
             .Cells(j, "c").Resize(1, 1).Value = tempBook.Sheets("ÃÒ§ҹ1").Range("d" & r).Value
             .Cells(j, "d").Resize(1, 1).Value = tempBook.Sheets("ÃÒ§ҹ1").Range("e" & r).Value
            .Cells(j, "b").Resize(1, 1).Value = tempBook.Sheets("Home").Range("c12").Value
             .Cells(j, "g").Resize(1, 1).Value = tempBook.Sheets("Home").Range("c9").Value
             .Cells(j, "h").Resize(1, 1).Value = tempBook.Sheets("Home").Range("e9").Value
             .Cells(j, "a") = tempBook.Name
             j = j + 1
End If
r = r + 1
Loop
        End If
    End With
    tempBook.Close False
    fileName = Dir()
Loop
    Application.ScreenUpdating = True
    MsgBox ("ÃѺä¿Åì¨Ò¡ Directory " & Sheets("MaxM4").Range("o2").Value & " àÃÕºÃéÍÂáÅéǤèÐ")