Tìm lớp học gần nhất mà học viên đã học

[LuuGiaPhúc]

Cảm ơn bạn nhiều nha

Bạn chạy kiểm tra code dưới đây.
Các trường hợp cần bẫy lỗi không xét trong code nhé bạn

Sub A_lop_hoc_gan_nhat()
Dim Nguon
Dim ID, dau, cuoi
Dim CD
Dim N0, N1
Dim Kq
Dim rw, i, j, k, x, z, t

With Sheet1
    k = .Range("Y" & Rows.Count).End(xlUp).Row + 1
    Nguon = .Range("A6", .Range("Y" & k))
    cuoi = WorksheetFunction.Max(.Range("A6:A" & k))
    dau = WorksheetFunction.Min(.Range("A6:A" & k))
   
    ReDim Kq(1 To UBound(Nguon), 1 To 1)
    ReDim ID(dau To cuoi, 2) 'csdong, ngay, tenlop
    ReDim CD(6)
    rw = 1
    Do While rw < UBound(Nguon)
        CD(6) = Nguon(rw, 4)
        For i = rw To UBound(Nguon)
            If Nguon(i, 4) = CD(6) Then
                If Nguon(i, 25) <> "" Then
                    k = Nguon(i, 1)
                    If ID(k, 0) = 0 Then ID(k, 0) = i
                   
                    j = Nguon(i, 25)
                    If CD(j) = 0 Then
                        CD(j) = i
                        CD(0) = CD(0) + 1
                    Else
                        x = Split(Nguon(CD(j), 24), "/")
                        N0 = DateSerial(x(2), x(1), x(0))
                       
                        x = Split(Nguon(i, 24), "/")
                        N1 = DateSerial(x(2), x(1), x(0))
                       
                        If N1 > N0 Then CD(j) = i
                    End If
                End If
            Else
                rw = i
                Exit For
            End If
        Next i
        If CD(0) = 5 Then
            N0 = ID(k, 1)
            For j = 1 To 5
                x = Split(Nguon(CD(j), 24), "/")
                N1 = DateSerial(x(2), x(1), x(0))
               
                If N1 > N0 Then
                    N0 = N1
                    ID(k, 2) = CD(6)
                End If
            Next j
           
            Kq(ID(k, 0), 1) = ID(k, 2)
            ID(k, 1) = N0
        End If
        For j = 0 To 6
            CD(j) = Empty
        Next j
    Loop
       
    .Range("AB6").Resize(UBound(Kq), 1).ClearContents
    .Range("Ab6").Resize(UBound(Kq), 1) = Kq
End With
End Sub