Excel Forum

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

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 & " àÃÕºÃéÍÂáÅéǤèÐ")