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

Liên hệ QC
LuuGiaPhúc

LuuGiaPhúc

Thành viên chính thức
Tham gia
28/7/21
Bài viết
93
Được thích
28
Nhờ các anh chị giúp em đoạn code tìm lớp học gần nhất mà học viên đã học theo điều kiện :
Dựa theo Trainee ID (là mã số học viên, ở cột A), đếm theo số ngày chuyên đề (cột Y) : nếu học không đủ 5 chuyên đề (từ chuyên đề 1 đến 5) thì bỏ, không cần phải đếm, điền số 0 hoặc để trống vào cột AA.

Chú ý : có nhiều học viên học trùng , ví dụ chuyên đề 3 học 2 lần thì cũng chỉ tính là 1 chuyên đề, phải có học đủ chuyên đề 1 , 2, 3 , 4 , 5 thì mới tính và tìm ngày học gần nhất rồi điền tên lớp học đó vào. các chuyên đề không nhất thiết phải học theo thứ tự , có thể học lộn xộn 3 , 4 , 2, 1 , 5 hoặc 4 , 2 , 5 , 3 , 1 ... miễn sao học đủ 5 chuyên đề là được.

Hiện tại em dùng cách ghép trainee Id và chuyên đề lại rồi remove duplicated để lọc bỏ lớp học trùng.
Sau đó tách trainee ID ra và countif trainee ID để đếm số lượng lớp đã học xem đủ 5 lớp hay không.
Cuối cùng dùng hàm maxifs để tìm ngày học gần nhất rồi tra cứu ngang qua để lấy tên lớp học .
Tuy nhiên , phần ngày học do xuất từ phần mềm xuống rồi import vào nên hình như nó định dạng kiểu gì lạ lắm. em dùng hàm maxifs để tìm ngày học lớn nhất theo value của cột X mà nó không tìm ra (hình như ngày học đang hiểu theo dạng text hay sao đó nên hàm maxifs cho kết quả =0 hết).
Em phải thếm cột phụ chuyển cột X thành Value rồi thì hàm MAXIFS mới đếm được

Do data của em khá lớn, khoảng 160.000 ~ 170.000 dòng nên mỗi lần chạy là nó treo máy khoảng 10 phut mới xong. cực kỳ ức chế luôn.
Nhờ các anh chị làm giúp cách nào cho nó chạy nhanh hơn ạ.
Em cảm ơn rất nhiều
1636033973693.png
 

File đính kèm

  • Book1.xlsb
    3.1 MB · Đọc: 8
Lần chỉnh sửa cuối:
LuuGiaPhúc đã viết:
Nhờ các anh chị giúp em đoạn code tìm lớp học gần nhất mà học viên đã học theo điều kiện :
Dựa theo Trainee ID (là mã số học viên, ở cột A), đếm theo số ngày chuyên đề (cột Y) : nếu học không đủ 5 chuyên đề (từ chuyên đề 1 đến 5) thì bỏ, không cần phải đếm, điền số 0 hoặc để trống vào cột AA.

Chú ý : có nhiều học viên học trùng , ví dụ chuyên đề 3 học 2 lần thì cũng chỉ tính là 1 chuyên đề, phải có học đủ chuyên đề 1 , 2, 3 , 4 , 5 thì mới tính và tìm ngày học gần nhất rồi điền tên lớp học đó vào. các chuyên đề không nhất thiết phải học theo thứ tự , có thể học lộn xộn 3 , 4 , 2, 1 , 5 hoặc 4 , 2 , 5 , 3 , 1 ... miễn sao học đủ 5 chuyên đề là được.

Hiện tại em dùng cách ghép trainee Id và chuyên đề lại rồi remove duplicated để lọc bỏ lớp học trùng.
Sau đó tách trainee ID ra và countif trainee ID để đếm số lượng lớp đã học xem đủ 5 lớp hay không.
Cuối cùng dùng hàm maxifs để tìm ngày học gần nhất rồi tra cứu ngang qua để lấy tên lớp học .
Tuy nhiên , phần ngày học do xuất từ phần mềm xuống rồi import vào nên hình như nó định dạng kiểu gì lạ lắm. em dùng hàm maxifs để tìm ngày học lớn nhất theo value của cột X mà nó không tìm ra (hình như ngày học đang hiểu theo dạng text hay sao đó nên hàm maxifs cho kết quả =0 hết).
Em phải thếm cột phụ chuyển cột X thành Value rồi thì hàm MAXIFS mới đếm được

Do data của em khá lớn, khoảng 160.000 ~ 170.000 dòng nên mỗi lần chạy là nó treo máy khoảng 10 phut mới xong. cực kỳ ức chế luôn.
Nhờ các anh chị làm giúp cách nào cho nó chạy nhanh hơn ạ.
Em cảm ơn rất nhiều
View attachment 268775
Nhấp chuột vào đây để mở rộng...
Thay đổi điều chỉnh gì bạn tự xử nhé
Mã: 
Option Explicit

Sub abcd()
Dim Nguon
Dim CD, Lop, Sl
Dim Ngay
Dim Kq
Dim i, j, k, x, z, t

Sl = 5
ReDim CD(Sl), Lop(Sl)
With Sheet1
    k = .Range("Y" & Rows.Count).End(xlUp).Row + 1
    Nguon = .Range("A6", .Range("Y" & k))
    ReDim Kq(1 To UBound(Nguon), 1 To 1)
    
    k = Nguon(1, 1)
    t = 1
    For i = 1 To UBound(Nguon)
        If Nguon(i, 1) = k Then
            If Nguon(i, 25) <> "" Then
                j = Nguon(i, 25)
                x = Split(Nguon(i, 24), "/")
                Ngay = DateSerial(x(2), x(1), x(0))
                If CD(j) = 0 Then
                    CD(j) = Ngay
                    Lop(j) = Nguon(i, 4)
                    CD(0) = CD(0) + 1
                Else
                    If CD(j) < Ngay Then CD(j) = Ngay
                End If
            End If
        Else
            If CD(0) = Sl Then
                z = 0
                For j = 1 To Sl
                    If z < CD(j) Then
                        z = CD(j)
                        Kq(t, 1) = Lop(j)
                    End If
                Next j
            End If
            For j = 0 To Sl
                CD(j) = 0
                Lop(j) = ""
            Next j
            If Nguon(i, 24) <> "" Then
                k = Nguon(i, 1)
                t = i
                j = Nguon(i, 25)
                x = Split(Nguon(i, 24), "/")
                Ngay = DateSerial(x(2), x(1), x(0))
                CD(j) = Ngay
                Lop(j) = Nguon(i, 4)
                CD(0) = 1
            End If
        End If
    Next i
    .Range("AG6").Resize(UBound(Kq), 1).ClearContents
    .Range("AG6").Resize(UBound(Kq), 1) = Kq
End With
End Sub
 
LuuGiaPhúc đã viết:
Nhờ các anh chị giúp em đoạn code tìm lớp học gần nhất mà học viên đã học theo điều kiện :
Dựa theo Trainee ID (là mã số học viên, ở cột A), đếm theo số ngày chuyên đề (cột Y) : nếu học không đủ 5 chuyên đề (từ chuyên đề 1 đến 5) thì bỏ, không cần phải đếm, điền số 0 hoặc để trống vào cột AA.

Chú ý : có nhiều học viên học trùng , ví dụ chuyên đề 3 học 2 lần thì cũng chỉ tính là 1 chuyên đề, phải có học đủ chuyên đề 1 , 2, 3 , 4 , 5 thì mới tính và tìm ngày học gần nhất rồi điền tên lớp học đó vào. các chuyên đề không nhất thiết phải học theo thứ tự , có thể học lộn xộn 3 , 4 , 2, 1 , 5 hoặc 4 , 2 , 5 , 3 , 1 ... miễn sao học đủ 5 chuyên đề là được.

Hiện tại em dùng cách ghép trainee Id và chuyên đề lại rồi remove duplicated để lọc bỏ lớp học trùng.
Sau đó tách trainee ID ra và countif trainee ID để đếm số lượng lớp đã học xem đủ 5 lớp hay không.
Cuối cùng dùng hàm maxifs để tìm ngày học gần nhất rồi tra cứu ngang qua để lấy tên lớp học .
Tuy nhiên , phần ngày học do xuất từ phần mềm xuống rồi import vào nên hình như nó định dạng kiểu gì lạ lắm. em dùng hàm maxifs để tìm ngày học lớn nhất theo value của cột X mà nó không tìm ra (hình như ngày học đang hiểu theo dạng text hay sao đó nên hàm maxifs cho kết quả =0 hết).
Em phải thếm cột phụ chuyển cột X thành Value rồi thì hàm MAXIFS mới đếm được

Do data của em khá lớn, khoảng 160.000 ~ 170.000 dòng nên mỗi lần chạy là nó treo máy khoảng 10 phut mới xong. cực kỳ ức chế luôn.
Nhờ các anh chị làm giúp cách nào cho nó chạy nhanh hơn ạ.
Em cảm ơn rất nhiều
View attachment 268775
Nhấp chuột vào đây để mở rộng...
Add Thêm sheet2 lưu kết quả
Mã: 
Option Explicit
Sub ABC()
  Dim sArr(), Res(), MaHV$, tmp$, lop$
  Dim sRow&, i&, k&, ngay, nMax As Date
 
  With Sheets("Sheet1")
    sArr = .Range("A6:Y" & .Range("Y" & Rows.Count).End(xlUp).Row + 1).Value
  End With
  sRow = UBound(sArr) - 1
  ReDim Res(1 To sRow, 1 To 5)
  For i = 1 To sRow
    If MaHV <> sArr(i, 1) Then
      MaHV = sArr(i, 1)
      tmp = "12345": nMax = Empty
    End If
    ngay = sArr(i, 24)
    If ngay <> Empty Then      
        If IsDate(ngay) = False Then
          ngay = DateValue(Mid(ngay, 7, 4) & Mid(ngay, 3, 4) & Mid(ngay, 1, 2))
        End If
        If nMax < ngay Then nMax = ngay: lop = sArr(i, 4)
        tmp = Replace(tmp, CStr(sArr(i, 25)), "")      
    End If
    If MaHV <> sArr(i + 1, 1) Then
      If tmp = Empty Then
        k = k + 1
        Res(k, 1) = k
        Res(k, 2) = sArr(i, 1)
        Res(k, 3) = sArr(i, 8)
        Res(k, 4) = lop
        Res(k, 5) = nMax
      End If
    End If
  Next i
  With Sheets("Sheet2")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 3 Then .Range("A4:E" & i).ClearContents
    If k > 0 Then .Range("A4").Resize(k, 5) = Res
  End With
End Sub
 
Lần chỉnh sửa cuối:
HieuCD đã viết:
Thêm sheet2 lưu kết quả
Mã: 
Option Explicit
Sub ABC()
  Dim sArr(), Res(), MaHV$, tmp$, lop$
  Dim sRow&, i&, k&, ngay, nMax As Date
 
  With Sheets("Sheet1")
    sArr = .Range("A6:Y" & .Range("Y" & Rows.Count).End(xlUp).Row + 1).Value
  End With
  sRow = UBound(sArr) - 1
  ReDim Res(1 To sRow, 1 To 5)
  For i = 1 To sRow
    If MaHV <> sArr(i, 1) Then
      MaHV = sArr(i, 1)
      tmp = "12345": nMax = Empty
    End If
    ngay = sArr(i, 24)
    If ngay <> Empty Then
      If Mid(CStr(1 / 2), 2, 1) = "." Then
        If IsDate(ngay) = False Then
          ngay = DateValue(Mid(ngay, 7, 4) & Mid(ngay, 3, 4) & Mid(ngay, 1, 2))
        End If
        If nMax < ngay Then nMax = ngay: lop = sArr(i, 4)
        tmp = Replace(tmp, CStr(sArr(i, 25)), "")
      End If
    End If
    If MaHV <> sArr(i + 1, 1) Then
      If tmp = Empty Then
        k = k + 1
        Res(k, 1) = k
        Res(k, 2) = sArr(i, 1)
        Res(k, 3) = sArr(i, 8)
        Res(k, 4) = lop
        Res(k, 5) = nMax
      End If
    End If
  Next i
  With Sheets("Sheet2")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 3 Then .Range("A4:E" & i).ClearContents
    If k > 0 Then .Range("A4").Resize(k, 5) = Res
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
code của a quá tuyệt, nó nhanh không tưởng luôn. Cảm ơn anh
Bài đã được tự động gộp:

CHAOQUAY đã viết:
Thay đổi điều chỉnh gì bạn tự xử nhé
Mã: 
Option Explicit

Sub abcd()
Dim Nguon
Dim CD, Lop, Sl
Dim Ngay
Dim Kq
Dim i, j, k, x, z, t

Sl = 5
ReDim CD(Sl), Lop(Sl)
With Sheet1
    k = .Range("Y" & Rows.Count).End(xlUp).Row + 1
    Nguon = .Range("A6", .Range("Y" & k))
    ReDim Kq(1 To UBound(Nguon), 1 To 1)
   
    k = Nguon(1, 1)
    t = 1
    For i = 1 To UBound(Nguon)
        If Nguon(i, 1) = k Then
            If Nguon(i, 25) <> "" Then
                j = Nguon(i, 25)
                x = Split(Nguon(i, 24), "/")
                Ngay = DateSerial(x(2), x(1), x(0))
                If CD(j) = 0 Then
                    CD(j) = Ngay
                    Lop(j) = Nguon(i, 4)
                    CD(0) = CD(0) + 1
                Else
                    If CD(j) < Ngay Then CD(j) = Ngay
                End If
            End If
        Else
            If CD(0) = Sl Then
                z = 0
                For j = 1 To Sl
                    If z < CD(j) Then
                        z = CD(j)
                        Kq(t, 1) = Lop(j)
                    End If
                Next j
            End If
            For j = 0 To Sl
                CD(j) = 0
                Lop(j) = ""
            Next j
            If Nguon(i, 24) <> "" Then
                k = Nguon(i, 1)
                t = i
                j = Nguon(i, 25)
                x = Split(Nguon(i, 24), "/")
                Ngay = DateSerial(x(2), x(1), x(0))
                CD(j) = Ngay
                Lop(j) = Nguon(i, 4)
                CD(0) = 1
            End If
        End If
    Next i
    .Range("AG6").Resize(UBound(Kq), 1).ClearContents
    .Range("AG6").Resize(UBound(Kq), 1) = Kq
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Quá tuyệt. Code của bạn chạy đúng nhanh luôn.
Các anh chị trên GPE quá tuyệt vời.
 
Lần chỉnh sửa cuối:
CHAOQUAY đã viết:
Thay đổi điều chỉnh gì bạn tự xử nhé
Mã: 
Option Explicit

Sub abcd()
Dim Nguon
Dim CD, Lop, Sl
Dim Ngay
Dim Kq
Dim i, j, k, x, z, t

Sl = 5
ReDim CD(Sl), Lop(Sl)
With Sheet1
    k = .Range("Y" & Rows.Count).End(xlUp).Row + 1
    Nguon = .Range("A6", .Range("Y" & k))
    ReDim Kq(1 To UBound(Nguon), 1 To 1)
 
    k = Nguon(1, 1)
    t = 1
    For i = 1 To UBound(Nguon)
        If Nguon(i, 1) = k Then
            If Nguon(i, 25) <> "" Then
                j = Nguon(i, 25)
                x = Split(Nguon(i, 24), "/")
                Ngay = DateSerial(x(2), x(1), x(0))
                If CD(j) = 0 Then
                    CD(j) = Ngay
                    Lop(j) = Nguon(i, 4)
                    CD(0) = CD(0) + 1
                Else
                    If CD(j) < Ngay Then CD(j) = Ngay
                End If
            End If
        Else
            If CD(0) = Sl Then
                z = 0
                For j = 1 To Sl
                    If z < CD(j) Then
                        z = CD(j)
                        Kq(t, 1) = Lop(j)
                    End If
                Next j
            End If
            For j = 0 To Sl
                CD(j) = 0
                Lop(j) = ""
            Next j
            If Nguon(i, 24) <> "" Then
                k = Nguon(i, 1)
                t = i
                j = Nguon(i, 25)
                x = Split(Nguon(i, 24), "/")
                Ngay = DateSerial(x(2), x(1), x(0))
                CD(j) = Ngay
                Lop(j) = Nguon(i, 4)
                CD(0) = 1
            End If
        End If
    Next i
    .Range("AG6").Resize(UBound(Kq), 1).ClearContents
    .Range("AG6").Resize(UBound(Kq), 1) = Kq
End With
End Sub
Nhấp chuột vào đây để mở rộng...

Ui bạn ơi, mình phát hiện có 1 lớp bị sai . Ví dụ hình này, lớp GLI1UL2102 mới đúng. Thấy cái ô từ X17:X22 nó bị canh lề phải, có khi nào bị giống mình nói ở trên là định dạng ngày tháng sai nên nó không tìm ra ==> nó chỉ xét những lớp ở trên mà không xét đoạn X17:X22 ???

1636072645058.png
Bài đã được tự động gộp:

HieuCD đã viết:
Thêm sheet2 lưu kết quả
Mã: 
Option Explicit
Sub ABC()
  Dim sArr(), Res(), MaHV$, tmp$, lop$
  Dim sRow&, i&, k&, ngay, nMax As Date
 
  With Sheets("Sheet1")
    sArr = .Range("A6:Y" & .Range("Y" & Rows.Count).End(xlUp).Row + 1).Value
  End With
  sRow = UBound(sArr) - 1
  ReDim Res(1 To sRow, 1 To 5)
  For i = 1 To sRow
    If MaHV <> sArr(i, 1) Then
      MaHV = sArr(i, 1)
      tmp = "12345": nMax = Empty
    End If
    ngay = sArr(i, 24)
    If ngay <> Empty Then
      If Mid(CStr(1 / 2), 2, 1) = "." Then
        If IsDate(ngay) = False Then
          ngay = DateValue(Mid(ngay, 7, 4) & Mid(ngay, 3, 4) & Mid(ngay, 1, 2))
        End If
        If nMax < ngay Then nMax = ngay: lop = sArr(i, 4)
        tmp = Replace(tmp, CStr(sArr(i, 25)), "")
      End If
    End If
    If MaHV <> sArr(i + 1, 1) Then
      If tmp = Empty Then
        k = k + 1
        Res(k, 1) = k
        Res(k, 2) = sArr(i, 1)
        Res(k, 3) = sArr(i, 8)
        Res(k, 4) = lop
        Res(k, 5) = nMax
      End If
    End If
  Next i
  With Sheets("Sheet2")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 3 Then .Range("A4:E" & i).ClearContents
    If k > 0 Then .Range("A4").Resize(k, 5) = Res
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
code của anh có thể giúp em chỉnh cho nó trả kết quả về Sheet 1, cột AA , và chỉ cần kết quả là tên lớp thôi, không cần mấy cái khác thì đúng 100% ý em cần luôn á. Cảm ơn a
 

File đính kèm

  • Book1.xlsb
    3.2 MB · Đọc: 4
LuuGiaPhúc đã viết:
Ui bạn ơi, mình phát hiện có 1 lớp bị sai . Ví dụ hình này, lớp GLI1UL2102 mới đúng. Thấy cái ô từ X17:X22 nó bị canh lề phải, có khi nào bị giống mình nói ở trên là định dạng ngày tháng sai nên nó không tìm ra ==> nó chỉ xét những lớp ở trên mà không xét đoạn X17:X22 ???

View attachment 268797
Nhấp chuột vào đây để mở rộng...
Bạn tìm dòng trên thay = khối bên dưới là được
Mã: 
'If CD(j) < Ngay Then CD(j) = Ngay
If CD(j) < Ngay Then
    CD(j) = Ngay
    Lop(j) = Nguon(i, 4)
End If
 
Maika8008 đã viết:
Thế quái nào mà tôi dùng cái file của bài #3 không có kết quả (k=0) trong khi chủ thớt lại khen, cám ơn ào ào thế nhỉ?
Nhấp chuột vào đây để mở rộng...
Em thấy bài #3 ra kết quả mà anh , có điều bạn ấy đưa qua sheet 2 và gom các học viên lại nên không đúng với cái format mà em đang làm. Em có nói lại rồi đó. Dù sao, bạn HIEUCD cũng đã giúp em trong rất nhiều bài viết, em thật lòng cảm ơn vì điều đó.
Cũng may còn có bài #6 đã khớp và đúng với cái format mà em đang cần làm nên em đã sử dụng code của bạn CHAOQUAY.
Nhờ có diễn đàn này, nhờ các anh , các bạn đã rất nhiều lần giúp đỡ nên công việc của em nhẹ đi rất nhiều. em mới tiếp nhận vị trí này trong công ty , thấy phần công việc của bản thân mình và của các bạn khác trong nhóm phải làm việc với excel mà phải làm thủ công rất nhiều, mà hầu như không ai biết rằng trong excel có cái gọi là "code VBA", hihihi, nên mỗi ngày 1 chút, em đang tập hợp những công việc mang tính "lặp đi lặp lại" và theo những quy luật nhất định để chuyển nó qua thành sử dụng VBA cho mọi thứ nhanh và đỡ mất thời gian làm thủ công.
Cảm ơn anh Maika8008 , anh cũng đã giúp em trong rất nhiều bài viết, đặt biệt là bài thống kê hàng khuyến mãi mà bình thường em phải mở từng file (hơn 60 file trong 60 thư mục khác nhau) rồi copy từng sheet trong đó, gom lại rồi tính nhập xuất tồn hàng khuyến mãi.... nhờ bài đó của anh mà ngày trước em mất hơn 3 tiếng đồng hồ để làm, giờ mất chưa tới 10p là xong., hihiihi


1636206308242.png
 
LuuGiaPhúc đã viết:
code của anh có thể giúp em chỉnh cho nó trả kết quả về Sheet 1, cột AA , và chỉ cần kết quả là tên lớp thôi, không cần mấy cái khác thì đúng 100% ý em cần luôn á. Cảm ơn a
Nhấp chuột vào đây để mở rộng...
Chỉnh lại
Mã: 
Sub ABC()
  Dim sArr(), Res(), MaHV$, tmp$, lop$
  Dim sRow&, i&, ik&, ngay, nMax As Date
 
  With Sheets("Sheet1")
    sArr = .Range("A6:Y" & .Range("Y" & Rows.Count).End(xlUp).Row + 1).Value
  End With
  sRow = UBound(sArr) - 1
  ReDim Res(1 To sRow, 1 To 1)
  For i = 1 To sRow
    If MaHV <> sArr(i, 1) Then
      MaHV = sArr(i, 1)
      tmp = "12345": nMax = Empty: ik = i
    End If
    ngay = sArr(i, 24)
    If ngay <> Empty Then      
        If IsDate(ngay) = False Then
          ngay = DateValue(Mid(ngay, 7, 4) & Mid(ngay, 3, 4) & Mid(ngay, 1, 2))
        End If
        If nMax < ngay Then nMax = ngay: lop = sArr(i, 4)
        tmp = Replace(tmp, CStr(sArr(i, 25)), "")      
    End If
    If MaHV <> sArr(i + 1, 1) Then
      If tmp = Empty Then Res(ik, 1) = lop
    End If
  Next i
  Sheets("Sheet1").Range("AA6").Resize(sRow) = Res 'Ket qua cot "AA"
End Sub
 
Lần chỉnh sửa cuối:
HieuCD đã viết:
Thêm sheet2 lưu kết quả
Mã: 
Option Explicit
Sub ABC()
  Dim sArr(), Res(), MaHV$, tmp$, lop$
  Dim sRow&, i&, k&, ngay, nMax As Date
 
  With Sheets("Sheet1")
    sArr = .Range("A6:Y" & .Range("Y" & Rows.Count).End(xlUp).Row + 1).Value
  End With
  sRow = UBound(sArr) - 1
  ReDim Res(1 To sRow, 1 To 5)
  For i = 1 To sRow
    If MaHV <> sArr(i, 1) Then
      MaHV = sArr(i, 1)
      tmp = "12345": nMax = Empty
    End If
    ngay = sArr(i, 24)
    If ngay <> Empty Then
      If Mid(CStr(1 / 2), 2, 1) = "." Then
        If IsDate(ngay) = False Then
          ngay = DateValue(Mid(ngay, 7, 4) & Mid(ngay, 3, 4) & Mid(ngay, 1, 2))
        End If
        If nMax < ngay Then nMax = ngay: lop = sArr(i, 4)
        tmp = Replace(tmp, CStr(sArr(i, 25)), "")
      End If
    End If
    If MaHV <> sArr(i + 1, 1) Then
      If tmp = Empty Then
        k = k + 1
        Res(k, 1) = k
        Res(k, 2) = sArr(i, 1)
        Res(k, 3) = sArr(i, 8)
        Res(k, 4) = lop
        Res(k, 5) = nMax
      End If
    End If
  Next i
  With Sheets("Sheet2")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 3 Then .Range("A4:E" & i).ClearContents
    If k > 0 Then .Range("A4").Resize(k, 5) = Res
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Em đọc code của anh thấy bài này hay mà em chưa hiểu giải thuật lắm mong anh giải thích ý nghĩa các đoạn code sau với ạ:
For i = 1 To sRow
If MaHV <> sArr(i, 1) Then
MaHV = sArr(i, 1)
tmp = "12345": nMax = Empty
End If
ngay = sArr(i, 24)
If ngay <> Empty Then
If Mid(CStr(1 / 2), 2, 1) = "." Then
If IsDate(ngay) = False Then
ngay = DateValue(Mid(ngay, 7, 4) & Mid(ngay, 3, 4) & Mid(ngay, 1, 2))
End If
If nMax < ngay Then nMax = ngay: lop = sArr(i, 4)
tmp = Replace(tmp, CStr(sArr(i, 25)), "")
End If
End If

- Và ở đây em không thấy code của anh làm việc sắp xếp cho các mã học viên liền nhau, vì nhỡ đâu có các mã của cùng một học viên không liền dòng thì việc
If MaHV <> sArr(i + 1, 1) Then
If tmp = Empty Then
sợ có bị sai không ạ. Và chỗ này If tmp = Empty em lại cứ nghĩ phải là If tmp <> Empty.
- Thay vì dùng Dic thì anh dùng kiểu này cũng được hiểu là lọc ra danh sách duy nhất không ạ.

For i = 1 To sRow
If MaHV <> sArr(i, 1) Then
MaHV = sArr(i, 1)
tmp = "12345": nMax = Empty
End If

Mong anh giải thích thuật toán và chỉ bảo thêm ạ.
 
hoahuongduong1986 đã viết:
Em đọc code của anh thấy bài này hay mà em chưa hiểu giải thuật lắm mong anh giải thích ý nghĩa các đoạn code sau với ạ:
For i = 1 To sRow
If MaHV <> sArr(i, 1) Then
MaHV = sArr(i, 1)
tmp = "12345": nMax = Empty
End If
ngay = sArr(i, 24)
If ngay <> Empty Then
If Mid(CStr(1 / 2), 2, 1) = "." Then
If IsDate(ngay) = False Then
ngay = DateValue(Mid(ngay, 7, 4) & Mid(ngay, 3, 4) & Mid(ngay, 1, 2))
End If
If nMax < ngay Then nMax = ngay: lop = sArr(i, 4)
tmp = Replace(tmp, CStr(sArr(i, 25)), "")
End If
End If

- Và ở đây em không thấy code của anh làm việc sắp xếp cho các mã học viên liền nhau, vì nhỡ đâu có các mã của cùng một học viên không liền dòng thì việc
If MaHV <> sArr(i + 1, 1) Then
If tmp = Empty Then
sợ có bị sai không ạ. Và chỗ này If tmp = Empty em lại cứ nghĩ phải là If tmp <> Empty.
- Thay vì dùng Dic thì anh dùng kiểu này cũng được hiểu là lọc ra danh sách duy nhất không ạ.

For i = 1 To sRow
If MaHV <> sArr(i, 1) Then
MaHV = sArr(i, 1)
tmp = "12345": nMax = Empty
End If

Mong anh giải thích thuật toán và chỉ bảo thêm ạ.
Nhấp chuột vào đây để mở rộng...
Dữ liệu đã sắp xếp các mã học viên nên không cần dùng dic, tùy theo đặc điểm dữ liệu mà lựa chọn cách xử lý phù hợp
Bài nầy giải thuật khá phức tạp, bạn bấm phím chức năng F8 chạy từng dòng lệnh để xem cách xử lý
 
HieuCD đã viết:
Dữ liệu đã sắp xếp các mã học viên nên không cần dùng dic, tùy theo đặc điểm dữ liệu mà lựa chọn cách xử lý phù hợp
Bài nầy giải thuật khá phức tạp, bạn bấm phím chức năng F8 chạy từng dòng lệnh để xem cách xử lý
Nhấp chuột vào đây để mở rộng...
Thế em chỉ hỏi riêng chỗ này If Mid(CStr(1 / 2), 2, 1) = "." Then. Ý nghĩa là gì ạ. Hàm mid, CStr thì em biết nhưng chỗ này em chưa hiểu là gì ạ.
 
HieuCD đã viết:
Chỉnh lại
Mã: 
Sub ABC()
  Dim sArr(), Res(), MaHV$, tmp$, lop$
  Dim sRow&, i&, ik&, ngay, nMax As Date
 
  With Sheets("Sheet1")
    sArr = .Range("A6:Y" & .Range("Y" & Rows.Count).End(xlUp).Row + 1).Value
  End With
  sRow = UBound(sArr) - 1
  ReDim Res(1 To sRow, 1 To 1)
  For i = 1 To sRow
    If MaHV <> sArr(i, 1) Then
      MaHV = sArr(i, 1)
      tmp = "12345": nMax = Empty: ik = i
    End If
    ngay = sArr(i, 24)
    If ngay <> Empty Then
      If Mid(CStr(1 / 2), 2, 1) = "." Then
        If IsDate(ngay) = False Then
          ngay = DateValue(Mid(ngay, 7, 4) & Mid(ngay, 3, 4) & Mid(ngay, 1, 2))
        End If
        If nMax < ngay Then nMax = ngay: lop = sArr(i, 4)
        tmp = Replace(tmp, CStr(sArr(i, 25)), "")
      End If
    End If
    If MaHV <> sArr(i + 1, 1) Then
      If tmp = Empty Then Res(ik, 1) = lop
    End If
  Next i
  Sheets("Sheet1").Range("AA6").Resize(sRow) = Res 'Ket qua cot "AA"
End Sub
Nhấp chuột vào đây để mở rộng...
cảm ơn bạn nhé.
 
HieuCD đã viết:
Chỉnh lại
Mã: 
Sub ABC()
  Dim sArr(), Res(), MaHV$, tmp$, lop$
  Dim sRow&, i&, ik&, ngay, nMax As Date
 
  With Sheets("Sheet1")
    sArr = .Range("A6:Y" & .Range("Y" & Rows.Count).End(xlUp).Row + 1).Value
  End With
  sRow = UBound(sArr) - 1
  ReDim Res(1 To sRow, 1 To 1)
  For i = 1 To sRow
    If MaHV <> sArr(i, 1) Then
      MaHV = sArr(i, 1)
      tmp = "12345": nMax = Empty: ik = i
    End If
    ngay = sArr(i, 24)
    If ngay <> Empty Then  
        If IsDate(ngay) = False Then
          ngay = DateValue(Mid(ngay, 7, 4) & Mid(ngay, 3, 4) & Mid(ngay, 1, 2))
        End If
        If nMax < ngay Then nMax = ngay: lop = sArr(i, 4)
        tmp = Replace(tmp, CStr(sArr(i, 25)), "")  
    End If
    If MaHV <> sArr(i + 1, 1) Then
      If tmp = Empty Then Res(ik, 1) = lop
    End If
  Next i
  Sheets("Sheet1").Range("AA6").Resize(sRow) = Res 'Ket qua cot "AA"
End Sub
Nhấp chuột vào đây để mở rộng...
Có trường hợp này nó tìm chưa đúng nè bạn HieuCD ơi
1636289044042.png

Trường hợp này là 1 học viên (đúng Trainee ID và đúng số CMND) ==> là 1 người.
Người này học đủ 5 lớp, nhưng lại học đến 2 lần ==> nếu lọc bỏ trùng và chọn ngày học gần nhất là ngày 23/05/2021 thì kết quả sẽ trả về lớp TLO01UL2101.
Còn hàng thứ 346 sẽ cho kết quả =0 vì ngày học không phải ngày gần nhất thì mới đúng
code của bạn CHAOQUAY cũng bị lỗi tương tự ==> cho kết quả cả 2 lớp là sai
 
Lần chỉnh sửa cuối:
LuuGiaPhúc đã viết:
Có trường hợp này nó tìm chưa đúng nè bạn HieuCD ơi
View attachment 268879

Trường hợp này là 1 học viên (đúng Trainee ID và đúng số CMND) ==> là 1 người.
Người này học đủ 5 lớp, nhưng lại học đến 2 lần ==> nếu lọc bỏ trùng và chọn ngày học gần nhất là ngày 23/05/2021 thì kết quả sẽ trả về lớp TLO01UL2101.
Còn hàng thứ 346 sẽ cho kết quả =0 vì ngày học không phải ngày gần nhất thì mới đúng
code của bạn CHAOQUAY cũng bị lỗi tương tự ==> cho kết quả cả 2 lớp là sai
Nhấp chuột vào đây để mở rộng...
- Theo như bài 1, chỉ xét ID, không kể đến CMND

Về vị trí điền kết quả: Nếu ID đủ 5 khóa, dòng chứa mã ID đầu tiên sẽ là dòng điền kết quả.
VD: Mã 297279 sẽ điền vào dòng 346, dòng 356 để trống.

Mã: 
Option Explicit

Sub XXX()
Dim Nguon
Dim ID, dau, cuoi
Dim N0, N1
Dim Kq
Dim 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 ID(dau To cuoi, 6)
    
    For i = 1 To UBound(Nguon)
        If Nguon(i, 25) <> "" Then
            k = Nguon(i, 1)
            j = Nguon(i, 25)
            If ID(k, 0) = 0 Then ID(k, 6) = i
            If ID(k, j) = 0 Then
                ID(k, j) = i
                ID(k, 0) = ID(k, 0) + 1
            Else
                x = Split(Nguon(ID(k, 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 ID(k, j) = i
            End If
        End If
    Next i
    
    ReDim Kq(1 To UBound(Nguon), 1 To 1)
    For i = dau To cuoi
        If ID(i, 0) = 5 Then
            t = ID(i, 6)
            N0 = 0
            For j = 1 To 5
                z = ID(i, j)
                
                x = Split(Nguon(z, 24), "/")
                N1 = DateSerial(x(2), x(1), x(0))
                
                If N1 > N0 Then
                    k = z
                    N0 = N1
                End If
            Next j
            Kq(t, 1) = Nguon(k, 4)
        End If
    Next i
    
    .Range("AG6").Resize(UBound(Kq), 1).ClearContents
    .Range("AG6").Resize(UBound(Kq), 1) = Kq
End With
End Sub
 
CHAOQUAY đã viết:
- Theo như bài 1, chỉ xét ID, không kể đến CMND

Về vị trí điền kết quả: Nếu ID đủ 5 khóa, dòng chứa mã ID đầu tiên sẽ là dòng điền kết quả.
VD: Mã 297279 sẽ điền vào dòng 346, dòng 356 để trống.

Mã: 
Option Explicit

Sub XXX()
Dim Nguon
Dim ID, dau, cuoi
Dim N0, N1
Dim Kq
Dim 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 ID(dau To cuoi, 6)
 
    For i = 1 To UBound(Nguon)
        If Nguon(i, 25) <> "" Then
            k = Nguon(i, 1)
            j = Nguon(i, 25)
            If ID(k, 0) = 0 Then ID(k, 6) = i
            If ID(k, j) = 0 Then
                ID(k, j) = i
                ID(k, 0) = ID(k, 0) + 1
            Else
                x = Split(Nguon(ID(k, 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 ID(k, j) = i
            End If
        End If
    Next i
 
    ReDim Kq(1 To UBound(Nguon), 1 To 1)
    For i = dau To cuoi
        If ID(i, 0) = 5 Then
            t = ID(i, 6)
            N0 = 0
            For j = 1 To 5
                z = ID(i, j)
          
                x = Split(Nguon(z, 24), "/")
                N1 = DateSerial(x(2), x(1), x(0))
          
                If N1 > N0 Then
                    k = z
                    N0 = N1
                End If
            Next j
            Kq(t, 1) = Nguon(k, 4)
        End If
    Next i
 
    .Range("AG6").Resize(UBound(Kq), 1).ClearContents
    .Range("AG6").Resize(UBound(Kq), 1) = Kq
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Nếu xét theo Trainee ID thì dòng 346 và 356 cũng có thể xem như là 1 người vì ID giống nhau, nên nếu kết quả đúng như mong muốn thì nó phải để trống dòng 346 hoặc điền tên lớp học là TLO01UL2101 vào dòng 346 như cách mà bạn CHAOQUAY vừa mới sửa lại. Tuyệt vời ông mặt trời, hihihi
vì tuy từ dòng 346 đến 350 đã đủ 5 buổi nhưng còn phải xét ngày học có phải là gần nhất không, cái này em cũng không hiểu vì sao file từ hệ thống xuất xuống nó không sắp xếp 1 người liên tục mà lại bị cách quãng như trường hợp này (từ dòng 346 đến 350, rồi từ dòng 356 đến 360) cũng là người này.
Cảm ơn bạn đã dành thời gian sửa lại giúp mình nhé.
cuối tuần vui vẻ.
 
Lần chỉnh sửa cuối:
CHAOQUAY đã viết:
- Theo như bài 1, chỉ xét ID, không kể đến CMND

Về vị trí điền kết quả: Nếu ID đủ 5 khóa, dòng chứa mã ID đầu tiên sẽ là dòng điền kết quả.
VD: Mã 297279 sẽ điền vào dòng 346, dòng 356 để trống.

Mã: 
Option Explicit

Sub XXX()
Dim Nguon
Dim ID, dau, cuoi
Dim N0, N1
Dim Kq
Dim 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 ID(dau To cuoi, 6)
  
    For i = 1 To UBound(Nguon)
        If Nguon(i, 25) <> "" Then
            k = Nguon(i, 1)
            j = Nguon(i, 25)
            If ID(k, 0) = 0 Then ID(k, 6) = i
            If ID(k, j) = 0 Then
                ID(k, j) = i
                ID(k, 0) = ID(k, 0) + 1
            Else
                x = Split(Nguon(ID(k, 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 ID(k, j) = i
            End If
        End If
    Next i
  
    ReDim Kq(1 To UBound(Nguon), 1 To 1)
    For i = dau To cuoi
        If ID(i, 0) = 5 Then
            t = ID(i, 6)
            N0 = 0
            For j = 1 To 5
                z = ID(i, j)
              
                x = Split(Nguon(z, 24), "/")
                N1 = DateSerial(x(2), x(1), x(0))
              
                If N1 > N0 Then
                    k = z
                    N0 = N1
                End If
            Next j
            Kq(t, 1) = Nguon(k, 4)
        End If
    Next i
  
    .Range("AG6").Resize(UBound(Kq), 1).ClearContents
    .Range("AG6").Resize(UBound(Kq), 1) = Kq
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Nhờ bạn hỗ trợ thêm 1 lần nữa cho mình, hôm nay mình cần xuất 1 báo cáo khác tương tự : cũng tìm tên lớp học gần nhất, nhưng yêu cầu có chút thay đổi :
Xét đủ 5 chuyên đề theo từng lớp.
Chú ý : những bài viết ở trên là theo lớp UL Class nên chỉ cần học đủ 5 chuyên đề là được, mỗi chuyên đề học 1 lớp khác nhau cũng được ==> ra tên lớp học gần nhất
Nhưng lần này là lớp SD Class nên yêu cầu : tìm theo từng Trainee ID (mã học viên), xem học viên này học mỗi lớp đủ 5 chuyên đề hay không (5 chuyên đề của cùng 1 lớp), nếu lớp nào đủ 5 chuyên đề thì lấy ngày học ra so sánh để tìm ra tên lơp học gần nhất.
Như ví dụ này : học viên 280282 học 2 lớp GLI1SD2101 và lớp GLI1SD2102 : cả 2 lớp đều học đủ 5 chuyên đề == > xét ngày học gần nhất ==> chọn GLI1SD2102
1636521188458.png

Trường hợp 2 : Trainee ID 306518 : học 4 lớp : cả 4 lớp đều không đủ 5 chuyên đề ==> loại , để trống
1636521242789.png
 

File đính kèm

  • Dem so lop.xlsb
    3.9 MB · Đọc: 2
LuuGiaPhúc đã viết:
Nhờ bạn hỗ trợ thêm 1 lần nữa cho mình, hôm nay mình cần xuất 1 báo cáo khác tương tự : cũng tìm tên lớp học gần nhất, nhưng yêu cầu có chút thay đổi :
Xét đủ 5 chuyên đề theo từng lớp.
Chú ý : những bài viết ở trên là theo lớp UL Class nên chỉ cần học đủ 5 chuyên đề là được, mỗi chuyên đề học 1 lớp khác nhau cũng được ==> ra tên lớp học gần nhất
Nhưng lần này là lớp SD Class nên yêu cầu : tìm theo từng Trainee ID (mã học viên), xem học viên này học mỗi lớp đủ 5 chuyên đề hay không (5 chuyên đề của cùng 1 lớp), nếu lớp nào đủ 5 chuyên đề thì lấy ngày học ra so sánh để tìm ra tên lơp học gần nhất.
Như ví dụ này : học viên 280282 học 2 lớp GLI1SD2101 và lớp GLI1SD2102 : cả 2 lớp đều học đủ 5 chuyên đề == > xét ngày học gần nhất ==> chọn GLI1SD2102
View attachment 268962

Trường hợp 2 : Trainee ID 306518 : học 4 lớp : cả 4 lớp đều không đủ 5 chuyên đề ==> loại , để trống
View attachment 268963
Nhấp chuột vào đây để mở rộng...
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
Mã: 
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
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

H
  • Question
nhờ các bác viết mẫu cho em lệnh dùng checkbox để rút ngắn thời gian thao tác
Trả lời
15
Đọc
323
hiv174
H
kiencuong030184
  • Question
Nhờ giúp đỡ về ẩn dòng, cột có điều kiện
Trả lời
1
Đọc
37
BuiQuangThuan
B
T
V/v tối ưu xử lý đoạn code
Trả lời
1
Đọc
48
SA_DQ
SA_DQ
kiet317
Helloooooooooooo
    • Phẫn nộ
    • Buồn
Trả lời
1
Đọc
38
Hoàng Tuấn 868
H
H
  • Question
Code subtotal và tìm điều kiện
Trả lời
9
Đọc
119
Hoàng Tuấn 868
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom