Dùng code VBA thay hàm countifs (dữ liệu khoảng từ 150.000 ~ 300.000 dòng nên hàm countifs gây treo máy)

Liên hệ QC
A

alex-luu

Thành viên thường trực
Tham gia
10/3/15
Bài viết
300
Được thích
52
Chào các anh chị
Em nhờ các anh chị giúp em viết đoạn code để thay thế cho cách dùng hàm , vì lượng dữ liệu khá lớn (khoảng 150.000 ~ 300.000 dòng) nên nếu dùng lệnh thì máy chạy không nổi (treo máy luôn).

1622914524281.png

1. Cột Z : Z6=TRIM(SUBSTITUTE($W6," Class",""))&$Y6 : ghép loại lớp (cột W) với ngày chuyên đề (cột Y) lại thành lớp chuyên đề (bỏ phần " class" : có dấu cách phía trước) rồi fill down công thức xuống đến dòng cuối cùng (dựa theo cột A) .

2. Cột AL : copy cột L qua cột AL , lọc và bỏ đi những mã số trùng, fill down công thức xuống đến dòng cuối cùng (dựa theo cột A) .

3. Cột AM : đếm mã số đại lý (ở cột AL) , xem người này đã học tổng cộng bao nhiêu lớp SD (nếu cột AL trống thì khỏi đếm)
AM6=IF(LEN(AL6)<5,0,COUNTIFS($L$6:$L$300000,AL6,$W$6:$W$300000,"SD Class"))

4. Cột AN6:AS : tìm ra ngày học đầu tiên theo tên lớp đã học

Ví dụ học viên có mã số 0077252 đã học lớp SBW2 ,vào ngày 09/09/2016 và ngày 13/01/2017, vậy kết quả trả về ô AO7 phải là 09/09/2016 (ngày học lớp SBW2 ĐẦU TIÊN)

5. Cột AT : AT6=COUNTA(AN6:AS6) : đếm xem mã số đại lý (ở cột AL) đã học bao nhiêu lớp SBW

Cảm ơn các anh chị.
 

File đính kèm

  • book 1.xlsm
    5.7 MB · Đọc: 8
Lần chỉnh sửa cuối:
Dùng Pivot table được không?
Ghi chú: Tại sao countIfs > 0 lại lấy dòng ngang hàng ở cột X (X6)? có liên quan gì đến mã đã lọc duy nhất đâu?

1622892159476.png
 
ptm0412 đã viết:
Dùng Pivot table được không?
Ghi chú: Tại sao countIfs > 0 lại lấy dòng ngang hàng ở cột X (X6)? có liên quan gì đến mã đã lọc duy nhất đâu?

View attachment 260112
Nhấp chuột vào đây để mở rộng...

"Tại sao countIfs > 0 lại lấy dòng ngang hàng ở cột X (X6)? có liên quan gì đến mã đã lọc duy nhất đâu?"
countifs lớn hơn 0, tức là bạn này có đi học, mà có đi học thì mình lấy giá trị của ô X6 (ngày học) đưa vào để biết bạn này học ngày nào , thế thôi.
Pivot cũng được, nhưng vì em không rành cách sử dụng pivot, nên em hay bị lỗi ở 2 chỗ : 1 là mỗi khi cập nhật report mới vào, em hay quên refresh pivot => số liệu không cập nhật mới nhất. với mỗi lần muốn thay đổi cách xem thì em lại không biết phải chỉnh pivot như thế nào.
Nên nếu có cách khác (kiểu dùng code VBA, xuất ra thành Value hết luôn là hay nhất, còn nếu không được, thì cũng phải dùng pivot thôi (hihihi).
 
Lần chỉnh sửa cuối:
alex-luu đã viết:
Chào các anh chị
Em nhờ các anh chị giúp em đoạn code thay thế cho hàm countifs
Lý do nếu dùng hàm thì cũng cho kết quả đúng, nhưng khi kéo xuống 300.000 dòng thì nó treo máy luôn vì quá nặng.

NẾU CÓ THỂ, thay vì khóa chắc ăn từ L6:L300000, mình có cách nào để code tự dò từ L6 đến hàng cuối cùng có dữ liệu thôi, như vậy có thể nhẹ thêm 1 chút nào chăng ?
Nhấp chuột vào đây để mở rộng...
Góp vui thêm một cách
Dùng tạm đoạn code này.
Hy vọng giải quyết được vấn đề
Sub GPE()
Dim Arr(), KQ(), DMLOP()
Dim i&, j&, k&, d&, c&, col&, t&, n&
Dim dic As New Scripting.Dictionary
Dim sh As Worksheet

Set sh = ThisWorkbook.Sheets("Attendant")

d = sh.Cells(Rows.Count, 1).End(xlUp).Row
Arr = sh.Range("L6:Z" & d).Value

ReDim KQ(1 To d - 6, 1 To 10)
ReDim DMLOP(1 To 1, 1 To 10)
For i = 1 To UBound(Arr)
MSDL = Arr(i, 1): LOP = Arr(i, 15): ngay = Arr(i, 13)
If dic.Exists(LOP) = False Then
c = c + 1
dic.Add LOP, c
DMLOP(1, c) = LOP
End If
col = dic.Item(LOP)
If dic.Exists(MSDL) = False Then
t = t + 1
dic.Add MSDL, t
KQ(t, 1) = MSDL
KQ(t, c + 2) = ngay
Else
n = dic.Item(MSDL)
If KQ(n, col + 2) <> Empty Then
KQ(n, col + 2) = KQ(n, col + 2) & "&" & ngay
Else
KQ(n, col + 2) = ngay
End If
End If
col = 0
Next i
sh.Range("AL15:AS100").ClearContents
sh.[AL14] = "Mã sô DL"
sh.[AN14].Resize(, c) = DMLOP
sh.[AL15].Resize(t, c + 2) = KQ
Set dic = Nothing
End Sub
 

File đính kèm

  • MSDL_LỚP.xlsm
    44.5 KB · Đọc: 8
HUONGLIEN6577 đã viết:
Góp vui thêm một cách
Dùng tạm đoạn code này.
Hy vọng giải quyết được vấn đề
Sub GPE()
Dim Arr(), KQ(), DMLOP()
Dim i&, j&, k&, d&, c&, col&, t&, n&
Dim dic As New Scripting.Dictionary
Dim sh As Worksheet

Set sh = ThisWorkbook.Sheets("Attendant")

d = sh.Cells(Rows.Count, 1).End(xlUp).Row
Arr = sh.Range("L6:Z" & d).Value

ReDim KQ(1 To d - 6, 1 To 10)
ReDim DMLOP(1 To 1, 1 To 10)
For i = 1 To UBound(Arr)
MSDL = Arr(i, 1): LOP = Arr(i, 15): ngay = Arr(i, 13)
If dic.Exists(LOP) = False Then
c = c + 1
dic.Add LOP, c
DMLOP(1, c) = LOP
End If
col = dic.Item(LOP)
If dic.Exists(MSDL) = False Then
t = t + 1
dic.Add MSDL, t
KQ(t, 1) = MSDL
KQ(t, c + 2) = ngay
Else
n = dic.Item(MSDL)
If KQ(n, col + 2) <> Empty Then
KQ(n, col + 2) = KQ(n, col + 2) & "&" & ngay
Else
KQ(n, col + 2) = ngay
End If
End If
col = 0
Next i
sh.Range("AL15:AS100").ClearContents
sh.[AL14] = "Mã sô DL"
sh.[AN14].Resize(, c) = DMLOP
sh.[AL15].Resize(t, c + 2) = KQ
Set dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Chưa đúng lắm bạn ơi, các lớp học nó không sắp theo thứ tự SBW1 , SBW2 , SWB3.... hả ?
Với lại mình chạy code thì nó ra số liệu bắt đầu từ hàng thứ 6 trở xuống luôn, khỏi lặp lại cái tiêu đề làm chi, bạn cho dữ liệu xuất ra sau khi chạy code xong nó nằm luôn trong vùng AL6:AS..... luôn dùm mình nhé.
Bạn giúp mình lần nữa nhé.
Cảm ơn bạn nhiều

1622900413941.png
 
alex-luu đã viết:
"Tại sao countIfs > 0 lại lấy dòng ngang hàng ở cột X (X6)? có liên quan gì đến mã đã lọc duy nhất đâu?"
countifs lớn hơn 0, tức là bạn này có đi học, mà có đi học thì mình lấy giá trị của ô X6 (ngày học) đưa vào để biết bạn này học ngày nào , thế thôi.
Nhấp chuột vào đây để mở rộng...
X6, X7, ... còn so ngang ra đúng mã nhân viên, chứ X10 có đúng của mã học viên đâu?
 
ptm0412 đã viết:
X6, X7, ... còn so ngang ra đúng mã nhân viên, chứ X10 có đúng của mã học viên đâu?
Nhấp chuột vào đây để mở rộng...
À há, vậy là công thức của mình cũng bị sai rồi, cảm ơn bạn đã phát hiện ra điều này , ô AN9 là học viên có mã số 0098218, đã học lớp SBW1 vào ngày 25/08/2018 và ngày 06/08/2018 , vậy kết quả trả về ô AN9 phải là 06/08/2018 (ngày học lớp SBW1 ĐẦU TIÊN), vậy là các ô SBW2, SBW3 ... cũng vậy, bạn giúp mình nhé.
Cảm ơn bạn.
 
Nếu cho là với 300.000 dòng sẽ treo máy và nhờ người khác viết code thì phải đính kèm 300.000 dòng chứ nhỉ. Vì nếu không có thì người ta viết xong code lấy đâu ra dữ liệu để test? Test với vài chục dòng thấy chạy vù vù nhưng làm sao biết được với 300.000 sẽ không treo máy? Hay bắt người khác tự tạo dữ liệu?
 
batman1 đã viết:
Nếu cho là với 300.000 dòng sẽ treo máy và nhờ người khác viết code thì phải đính kèm 300.000 dòng chứ nhỉ. Vì nếu không có thì người ta viết xong code lấy đâu ra dữ liệu để test? Test với vài chục dòng thấy chạy vù vù nhưng làm sao biết được với 300.000 sẽ không treo máy? Hay bắt người khác tự tạo dữ liệu?
Nhấp chuột vào đây để mở rộng...
Dạ, nếu em để dữ liệu thực tế vào, dung lượng file lên đến 65MB, không cách gì gởi lên diễn đàn nổi ạ. Do em dùng hàm countifs như bài #1, em kéo fill xuống cái treo máy luôn, nhưng bạn ptm0412 nói ở trên, thì cái công thức của em cũng không đúng, nên em xin trình bày lại như sau :
Cột AL là lọc và bỏ mã số đại lý bị trùng.
Rồi sau đó từ cột AN6:AS... là tìm ra ngày học đầu tiên theo tên lớp đã học

Ví dụ học viên có mã số 0098218 đã học lớp SBW1 ,vào ngày 25/08/2018 và ngày 06/08/2018, vậy kết quả trả về ô AN9 phải là 28/05/2018 (ngày học lớp SBW1 ĐẦU TIÊN)

Tương tự :
học viên có mã số 0098218 đã học lớp SBW4 ,vào ngày 16/07/2018, vậy kết quả trả về ô AQ9 là 16/07/2018
 
Lần chỉnh sửa cuối:
alex-luu đã viết:
À há, vậy là công thức của mình cũng bị sai rồi, cảm ơn bạn đã phát hiện ra điều này , ô AN9 là học viên có mã số 0098218, đã học lớp SBW1 vào ngày 25/08/2018 và ngày 06/08/2018 , vậy kết quả trả về ô AN9 phải là 06/08/2018 (ngày học lớp SBW1 ĐẦU TIÊN), vậy là các ô SBW2, SBW3 ... cũng vậy, bạn giúp mình nhé.
Cảm ơn bạn.
Nhấp chuột vào đây để mở rộng...
AN9 sao lại 06/08/2018 được? phải là 28/05/2018 chứ?
Các ô khác cũng vậy, tôi làm Pivot table ra kết quả rồi.
 
Lần chỉnh sửa cuối:
alex-luu đã viết:
Chưa đúng lắm bạn ơi, các lớp học nó không sắp theo thứ tự SBW1 , SBW2 , SWB3.... hả ?
Với lại mình chạy code thì nó ra số liệu bắt đầu từ hàng thứ 6 trở xuống luôn, khỏi lặp lại cái tiêu đề làm chi, bạn cho dữ liệu xuất ra sau khi chạy code xong nó nằm luôn trong vùng AL6:AS..... luôn dùm mình nhé.
Bạn giúp mình lần nữa nhé.
Cảm ơn bạn nhiều.
Nhấp chuột vào đây để mở rộng...
Mình thấy bạn nói dữ liệu dài khoảng 300000 dòng ---> sẽ có rất nhiều lớp, do vậy mới làm để lấy tên lớp.
Lưu ý: Nếu 1 mã số ĐL mà có trên 1 lần học ở cùng một lớp (thời gian khác nhau) thì kết quả trả về sẽ là ngày đầu "&"...các lần tiếp theo. nếu không muốn thế thì phải sửa code (tôi tin là bạn làm được)
& chúc thành công.
 

File đính kèm

  • MSDL_LỚP.xlsm
    44.1 KB · Đọc: 10
HUONGLIEN6577 đã viết:
Mình thấy bạn nói dữ liệu dài khoảng 300000 dòng ---> sẽ có rất nhiều lớp, do vậy mới làm để lấy tên lớp.
Lưu ý: Nếu 1 mã số ĐL mà có trên 1 lần học ở cùng một lớp (thời gian khác nhau) thì kết quả trả về sẽ là ngày đầu "&"...các lần tiếp theo. nếu không muốn thế thì phải sửa code (tôi tin là bạn làm được)
& chúc thành công.
Nhấp chuột vào đây để mở rộng...
Tuyệt vời.
Cảm ơn bạn nhiều lắm

À bạn ơi, mình mới test lại, khi import hơn 150 dòng dữ liệu thì nó báo lỗi
1622905607558.png
 
Lần chỉnh sửa cuối:
Tôi có cảm giác là kết quả điền bằng tay trong tập tin và kết quả cần có là khác nhau. Vì thế tôi thử mô tả như sau:

Với mỗi ô từ dòng 6 trở xuống và từ cột AN tới AS, tiếp theo gọi là "ô đang xét", ta xác định được cặp (Mã, Lớp). Từ dòng 6 trở xuống ta xét các dòng có giá trị ở cột L = Mã, và ở cột Z = Lớp. Trong các dòng được xét đó ta lấy giá trị nhỏ nhất ở cột X để nhập vào "ô đang xét"

Tôi mô tả có đúng ý không? Nếu đúng thì thử code
Mã: 
Sub Copy_remove_duplicate()
 Dim lastRow As Long, r As Long, c As Long, ten_lop, pos, ma, dulieu(), ngay_lop(), tieude(), dic As Object, lop As Object
 Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Attendant")
    Range("AL6:AS10000").ClearContents
    lastRow = sh.Cells(Rows.Count, "L").End(xlUp).Row
    If lastRow < 6 Then Exit Sub
    dulieu = sh.Range("L6:L" & lastRow + 1).Value
    ngay_lop = sh.Range("X6:Z" & lastRow + 1).Value
    tieude = sh.Range("AL5:AS5").Value
    Set dic = CreateObject("Scripting.Dictionary")
    dic.comparemode = vbTextCompare
    For r = 1 To UBound(dulieu) - 1
        If Not dic.exists(dulieu(r, 1)) Then
            Set lop = CreateObject("Scripting.Dictionary")
            lop.comparemode = vbTextCompare
            lop.Add ngay_lop(r, 3), ngay_lop(r, 1)
            dic.Add CStr(dulieu(r, 1)), lop
        Else
            Set lop = dic.Item(dulieu(r, 1))
            If Not lop.exists(ngay_lop(r, 3)) Then
                lop.Add ngay_lop(r, 3), ngay_lop(r, 1)
            Else
                If ngay_lop(r, 1) < lop.Item(ngay_lop(r, 3)) Then lop.Item(ngay_lop(r, 3)) = ngay_lop(r, 1)
            End If
            Set dic.Item(dulieu(r, 1)) = lop
        End If
    Next r
    ReDim dulieu(1 To dic.Count, 1 To 8)
    r = 0
    For Each ma In dic.keys
        r = r + 1
        dulieu(r, 1) = "'" & ma
        Set lop = dic.Item(ma)
        For Each ten_lop In lop.keys
            pos = Application.Match(ten_lop, tieude, 0)
            If Not IsError(pos) Then dulieu(r, pos) = lop.Item(ten_lop)
        Next ten_lop
    Next ma
 
    Range("AL6:AS6").Resize(UBound(dulieu, 1)).Value = dulieu
 
    Set dic = Nothing
    Set lop = Nothing
End Sub
-----------
Tên lớp SBW1, ..., SBW5 thì quá dễ. Code của tôi chấp nhận các tên khác nhau rất nhiều. Vd. Lớp = "Chuyên Văn", "Toán đại cương", "Hóa nâng cao". Vì thế trong code có MATCH. Còn như hiện giờ thì quá dễ: <chỉ số cột> = Right(lớp, 1)

Lưu ý: hiện thời các cột thời gian không là thời gian chuẩn. Chúng là thời gian nhái, cần sửa lại cho chuẩn thời gian.
 
Lần chỉnh sửa cuối:
batman1 đã viết:
Tôi có cảm giác là kết quả điền bằng tay trong tập tin và kết quả cần có là khác nhau. Vì thế tôi thử mô tả như sau:

Với mỗi ô từ dòng 6 trở xuống và từ cột AN tới AS, tiếp theo gọi là "ô đang xét", ta xác định được cặp (Mã, Lớp). Từ dòng 6 trở xuống ta xét các dòng có giá trị ở cột L = Mã, và ở cột Z = Lớp. Trong các dòng được xét đó ta lấy giá trị nhỏ nhất ở cột X để nhập vào "ô đang xét"
Nhấp chuột vào đây để mở rộng...
Anh mô tả đúng, anh viết code, thì Pivot table của tôi bị ế mất
 
HUONGLIEN6577 đã viết:
Mình thấy bạn nói dữ liệu dài khoảng 300000 dòng ---> sẽ có rất nhiều lớp, do vậy mới làm để lấy tên lớp.
Lưu ý: Nếu 1 mã số ĐL mà có trên 1 lần học ở cùng một lớp (thời gian khác nhau) thì kết quả trả về sẽ là ngày đầu "&"...các lần tiếp theo. nếu không muốn thế thì phải sửa code (tôi tin là bạn làm được)
& chúc thành công.
Nhấp chuột vào đây để mở rộng...
Bạn ơi, mình mới phát hiện ra, nếu mình cho dữ liệu dưới 150 dòng thì chạy chính xác, nhưng trên 150 dòng thì nó báo lỗi
1622905170721.png
 

File đính kèm

  • MSDL_LỚP (3).xlsm
    43.1 KB · Đọc: 6
HUONGLIEN6577 đã viết:
Mình thấy bạn nói dữ liệu dài khoảng 300000 dòng ---> sẽ có rất nhiều lớp, do vậy mới làm để lấy tên lớp.
Lưu ý: Nếu 1 mã số ĐL mà có trên 1 lần học ở cùng một lớp (thời gian khác nhau) thì kết quả trả về sẽ là ngày đầu "&"...các lần tiếp theo. nếu không muốn thế thì phải sửa code (tôi tin là bạn làm được)
& chúc thành công.
Nhấp chuột vào đây để mở rộng...
Rất thích bạn qua các hoạt động gần đây của bạn. Nhìn profile của bạn tôi càng phục hơn.
 
batman1 đã viết:
Tôi có cảm giác là kết quả điền bằng tay trong tập tin và kết quả cần có là khác nhau. Vì thế tôi thử mô tả như sau:

Với mỗi ô từ dòng 6 trở xuống và từ cột AN tới AS, tiếp theo gọi là "ô đang xét", ta xác định được cặp (Mã, Lớp). Từ dòng 6 trở xuống ta xét các dòng có giá trị ở cột L = Mã, và ở cột Z = Lớp. Trong các dòng được xét đó ta lấy giá trị nhỏ nhất ở cột X để nhập vào "ô đang xét"

Tôi mô tả có đúng ý không? Nếu đúng thì thử code
Mã: 
Sub Copy_remove_duplicate()
 Dim lastRow As Long, r As Long, c As Long, ten_lop, pos, ma, dulieu(), ngay_lop(), tieude(), dic As Object, lop As Object
 Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Attendant")
    Range("AL6:AS10000").ClearContents
    lastRow = sh.Cells(Rows.Count, "L").End(xlUp).Row
    If lastRow < 6 Then Exit Sub
    dulieu = sh.Range("L6:L" & lastRow + 1).Value
    ngay_lop = sh.Range("X6:Z" & lastRow + 1).Value
    tieude = sh.Range("AL5:AS5").Value
    Set dic = CreateObject("Scripting.Dictionary")
    dic.comparemode = vbTextCompare
    For r = 1 To UBound(dulieu) - 1
        If Not dic.exists(dulieu(r, 1)) Then
            Set lop = CreateObject("Scripting.Dictionary")
            lop.comparemode = vbTextCompare
            lop.Add ngay_lop(r, 3), ngay_lop(r, 1)
            dic.Add CStr(dulieu(r, 1)), lop
        Else
            Set lop = dic.Item(dulieu(r, 1))
            If Not lop.exists(ngay_lop(r, 3)) Then
                lop.Add ngay_lop(r, 3), ngay_lop(r, 1)
            Else
                If ngay_lop(r, 1) < lop.Item(ngay_lop(r, 3)) Then lop.Item(ngay_lop(r, 3)) = ngay_lop(r, 1)
            End If
            Set dic.Item(dulieu(r, 1)) = lop
        End If
    Next r
    ReDim dulieu(1 To dic.Count, 1 To 8)
    r = 0
    For Each ma In dic.keys
        r = r + 1
        dulieu(r, 1) = "'" & ma
        Set lop = dic.Item(ma)
        For Each ten_lop In lop.keys
            pos = Application.Match(ten_lop, tieude, 0)
            If Not IsError(pos) Then dulieu(r, pos) = lop.Item(ten_lop)
        Next ten_lop
    Next ma
 
    Range("AL6:AS6").Resize(UBound(dulieu, 1)).Value = dulieu
 
    Set dic = Nothing
    Set lop = Nothing
End Sub
-----------
Tên lớp SBW1, ..., SBW5 thì quá dễ. Code của tôi chấp nhận các tên khác nhau rất nhiều. Vd. Lớp = "Chuyên Văn", "Toán đại cương", "Hóa nâng cao". Vì thế trong code có MATCH. Còn như hiện giờ thì quá dễ: <chỉ số cột> = Right(lớp, 1)

Lưu ý: hiện thời các cột thời gian không là thời gian chuẩn. Chúng là thời gian nhái, cần sửa lại cho chuẩn thời gian.
Nhấp chuột vào đây để mở rộng...

batman1 đã viết:
Tôi có cảm giác là kết quả điền bằng tay trong tập tin và kết quả cần có là khác nhau. Vì thế tôi thử mô tả như sau:

Với mỗi ô từ dòng 6 trở xuống và từ cột AN tới AS, tiếp theo gọi là "ô đang xét", ta xác định được cặp (Mã, Lớp). Từ dòng 6 trở xuống ta xét các dòng có giá trị ở cột L = Mã, và ở cột Z = Lớp. Trong các dòng được xét đó ta lấy giá trị nhỏ nhất ở cột X để nhập vào "ô đang xét"

Tôi mô tả có đúng ý không? Nếu đúng thì thử code
Mã: 
Sub Copy_remove_duplicate()
 Dim lastRow As Long, r As Long, c As Long, ten_lop, pos, ma, dulieu(), ngay_lop(), tieude(), dic As Object, lop As Object
 Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Attendant")
    Range("AL6:AS10000").ClearContents
    lastRow = sh.Cells(Rows.Count, "L").End(xlUp).Row
    If lastRow < 6 Then Exit Sub
    dulieu = sh.Range("L6:L" & lastRow + 1).Value
    ngay_lop = sh.Range("X6:Z" & lastRow + 1).Value
    tieude = sh.Range("AL5:AS5").Value
    Set dic = CreateObject("Scripting.Dictionary")
    dic.comparemode = vbTextCompare
    For r = 1 To UBound(dulieu) - 1
        If Not dic.exists(dulieu(r, 1)) Then
            Set lop = CreateObject("Scripting.Dictionary")
            lop.comparemode = vbTextCompare
            lop.Add ngay_lop(r, 3), ngay_lop(r, 1)
            dic.Add CStr(dulieu(r, 1)), lop
        Else
            Set lop = dic.Item(dulieu(r, 1))
            If Not lop.exists(ngay_lop(r, 3)) Then
                lop.Add ngay_lop(r, 3), ngay_lop(r, 1)
            Else
                If ngay_lop(r, 1) < lop.Item(ngay_lop(r, 3)) Then lop.Item(ngay_lop(r, 3)) = ngay_lop(r, 1)
            End If
            Set dic.Item(dulieu(r, 1)) = lop
        End If
    Next r
    ReDim dulieu(1 To dic.Count, 1 To 8)
    r = 0
    For Each ma In dic.keys
        r = r + 1
        dulieu(r, 1) = "'" & ma
        Set lop = dic.Item(ma)
        For Each ten_lop In lop.keys
            pos = Application.Match(ten_lop, tieude, 0)
            If Not IsError(pos) Then dulieu(r, pos) = lop.Item(ten_lop)
        Next ten_lop
    Next ma
 
    Range("AL6:AS6").Resize(UBound(dulieu, 1)).Value = dulieu
 
    Set dic = Nothing
    Set lop = Nothing
End Sub
-----------
Tên lớp SBW1, ..., SBW5 thì quá dễ. Code của tôi chấp nhận các tên khác nhau rất nhiều. Vd. Lớp = "Chuyên Văn", "Toán đại cương", "Hóa nâng cao". Vì thế trong code có MATCH. Còn như hiện giờ thì quá dễ: <chỉ số cột> = Right(lớp, 1)

Lưu ý: hiện thời các cột thời gian không là thời gian chuẩn. Chúng là thời gian nhái, cần sửa lại cho chuẩn thời gian.
Nhấp chuột vào đây để mở rộng...
Em mới test thử 200.000 hàng dữ liệu và code của anh chạy rất đúng ý em muốn.
Cảm ơn anh. Code chỉ chạy khoảng hơn 1phut là xong. Tuyệt vời
Bài đã được tự động gộp:

ptm0412 đã viết:
Anh mô tả đúng, anh viết code, thì Pivot table của tôi bị ế mất
Nhấp chuột vào đây để mở rộng...
Thực ra tại vì em không biết sử dụng Pivot nên em hơi "ngán" thôi, chắc sẽ dành thời gian lên google tìm hiểu thêm về pivot.
Cảm ơn bạn
 
Lần chỉnh sửa cuối:
alex-luu đã viết:
Chào các anh chị
Em nhờ các anh chị giúp em đoạn code thay thế cho hàm countifs

Cột L đến Y là dữ liệu thô import từ các file báo cáo gởi về (dữ liệu khoảng từ 150.000 ~ 300.000 dòng tùy từng tháng)
Em muốn tạo button, khi nhấn vào thì nó sẽ copy cột L rồi dán qua cột AL (rồi remove những dòng duplicate).

Sau đó, từ những mã số đại lý ở cột AL, tra qua bảng bên trái, xem ngày học ĐẦU TIÊN của từng lớp,
Ví dụ học viên có mã số 0098218 đã học lớp SBW1 ,vào ngày 25/08/2018 và ngày 06/08/2018, vậy kết quả trả về ô AN9 sẽ là 28/05/2018 (ngày học lớp SBW1 ĐẦU TIÊN)

Tương tự :
học viên có mã số 0098218 đã học lớp SBW4 ,vào ngày 16/07/2018, vậy kết quả trả về ô AQ9 là 16/07/2018

Sub Copy_remove_duplicate()
Dim LastRow As Long
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Attendant")
LastRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
Range("L6:L" & LastRow).Copy Range("AL6:AL" & LastRow)
ActiveSheet.Range("AL6:AL" & LastRow).RemoveDuplicates Columns:=1
End Sub


View attachment 260110
Nhấp chuột vào đây để mở rộng...
Tiêu đề cột kết quả đã có, chỉ lọc lấy mã số đại lý, code chuyển dữ liệu ngày tháng dạng text thành dạng date
Nếu tiêu đề chưa có hoặc thiếu tên lớp cần thêm lệnh lấy tên lớp
Mã: 
Sub XYZ()
  Dim aDaiLy(), aLop(), aTieuDe(), Res$(), Res2(), dic As Object
  Dim sRow&, sCol&, i&, r&, iR&, j&, jC&, ngay, iKey$
  
  Set dic = CreateObject("Scripting.Dictionary")
  dic.comparemode = vbTextCompare
  With Sheets("Attendant")
    .Range("AL6:AS10000").ClearContents
    i = .Range("L" & Rows.Count).End(xlUp).Row
    If i < 6 Then Exit Sub
    aDaiLy = .Range("L6:L" & i).Value
    aLop = .Range("X6:Z" & i).Value
    aTieuDe = .Range("AN5:AS5").Value
  End With
  sRow = UBound(aLop):  sCol = UBound(aTieuDe, 2)
  ReDim Res(1 To sRow, 1 To 1)
  ReDim Res2(1 To sRow, 1 To sCol)
  For j = 1 To sCol
    dic.Item(aTieuDe(1, j)) = j
  Next j
  For i = 1 To sRow
    ngay = DateValue(Mid(aLop(i, 1), 7, 4) & Mid(aLop(i, 1), 3, 4) & Mid(aLop(i, 1), 1, 2))
    iKey = aDaiLy(i, 1)
    If Not dic.exists(iKey) Then
      r = r + 1
      dic.Add iKey, r
      Res(r, 1) = iKey
    End If
    iR = dic.Item(iKey):    jC = dic.Item(aLop(i, 3))
    iKey = aDaiLy(i, 1) & aLop(i, 3)
    If Not dic.exists(iKey) Then
      dic.Add iKey, ngay
      Res2(iR, jC) = ngay
    ElseIf ngay < dic.Item(iKey) Then
        dic.Item(iKey) = ngay
        Res2(iR, jC) = ngay
    End If
  Next i
  With Sheets("Attendant")
    .Range("AL6").Resize(r).Value = Res
    .Range("AN6").Resize(r, sCol).Value = Res2
    .Range("AN6").Resize(r, sCol).NumberFormat = "dd/mm/yyyy"
  End With
  Set dic = Nothing
End Sub
 
Lần chỉnh sửa cuối:
batman1 đã viết:
Tôi có cảm giác là kết quả điền bằng tay trong tập tin và kết quả cần có là khác nhau. Vì thế tôi thử mô tả như sau:

Với mỗi ô từ dòng 6 trở xuống và từ cột AN tới AS, tiếp theo gọi là "ô đang xét", ta xác định được cặp (Mã, Lớp). Từ dòng 6 trở xuống ta xét các dòng có giá trị ở cột L = Mã, và ở cột Z = Lớp. Trong các dòng được xét đó ta lấy giá trị nhỏ nhất ở cột X để nhập vào "ô đang xét"

Tôi mô tả có đúng ý không? Nếu đúng thì thử code
Mã: 
Sub Copy_remove_duplicate()
 Dim lastRow As Long, r As Long, c As Long, ten_lop, pos, ma, dulieu(), ngay_lop(), tieude(), dic As Object, lop As Object
 Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Attendant")
    Range("AL6:AS10000").ClearContents
    lastRow = sh.Cells(Rows.Count, "L").End(xlUp).Row
    If lastRow < 6 Then Exit Sub
    dulieu = sh.Range("L6:L" & lastRow + 1).Value
    ngay_lop = sh.Range("X6:Z" & lastRow + 1).Value
    tieude = sh.Range("AL5:AS5").Value
    Set dic = CreateObject("Scripting.Dictionary")
    dic.comparemode = vbTextCompare
    For r = 1 To UBound(dulieu) - 1
        If Not dic.exists(dulieu(r, 1)) Then
            Set lop = CreateObject("Scripting.Dictionary")
            lop.comparemode = vbTextCompare
            lop.Add ngay_lop(r, 3), ngay_lop(r, 1)
            dic.Add CStr(dulieu(r, 1)), lop
        Else
            Set lop = dic.Item(dulieu(r, 1))
            If Not lop.exists(ngay_lop(r, 3)) Then
                lop.Add ngay_lop(r, 3), ngay_lop(r, 1)
            Else
                If ngay_lop(r, 1) < lop.Item(ngay_lop(r, 3)) Then lop.Item(ngay_lop(r, 3)) = ngay_lop(r, 1)
            End If
            Set dic.Item(dulieu(r, 1)) = lop
        End If
    Next r
    ReDim dulieu(1 To dic.Count, 1 To 8)
    r = 0
    For Each ma In dic.keys
        r = r + 1
        dulieu(r, 1) = "'" & ma
        Set lop = dic.Item(ma)
        For Each ten_lop In lop.keys
            pos = Application.Match(ten_lop, tieude, 0)
            If Not IsError(pos) Then dulieu(r, pos) = lop.Item(ten_lop)
        Next ten_lop
    Next ma
 
    Range("AL6:AS6").Resize(UBound(dulieu, 1)).Value = dulieu
 
    Set dic = Nothing
    Set lop = Nothing
End Sub
-----------
Tên lớp SBW1, ..., SBW5 thì quá dễ. Code của tôi chấp nhận các tên khác nhau rất nhiều. Vd. Lớp = "Chuyên Văn", "Toán đại cương", "Hóa nâng cao". Vì thế trong code có MATCH. Còn như hiện giờ thì quá dễ: <chỉ số cột> = Right(lớp, 1)

Lưu ý: hiện thời các cột thời gian không là thời gian chuẩn. Chúng là thời gian nhái, cần sửa lại cho chuẩn thời gian.
Nhấp chuột vào đây để mở rộng...

Bạn ơi, code của bạn là chuẩn rồi. Tuyệt vời, mình đã thử hơn 280.000 dòng, chạy tốt, file không quá nặng như lúc đầu mình làm.
Giờ phiền bạn giúp 1 lần nữa, vì mình định bổ sung thêm 3 cột mà lúc đầu mình không nghĩ tới, bạn giúp mình lần nữa nhé. chuyển 3 cột này dùng bằng code VBA để tính để nhẹ file.
1. Cột AM : Lớp SD Class : đếm tổng số lớp SD , SD Class (ở cột W) mà mã số đại lý đã theo học bằng cách dò mã số đại lý (cột AL), dò trong vùng L:W. (hiện mình đang dùng công thức =IF(LEN(AL6)<5,0,COUNTIFS($L$6:$L$300000,AL6,$W$6:$W$300000,"SD Class"))
2. Cột AT : tính tổng số lớp SBW mà mã số đại lý đã theo học AT6=COUNTA(AN6:AS6)
3. Cột Z6=TRIM(SUBSTITUTE($W6," Class",""))&$Y6
1622914831361.png
Cảm ơn bạn
 

File đính kèm

  • book 1.xlsm
    5.7 MB · Đọc: 3
Lần chỉnh sửa cuối:
HieuCD đã viết:
Tiêu đề cột kết quả đã có, chỉ lọc lấy mã số đại lý, code chuyển dữ liệu ngày tháng dạng text thành dạng date
Nếu tiêu đề chưa có hoặc thiếu tên lớp cần thêm lệnh lấy tên lớp
Mã: 
Sub XYZ()
  Dim aDaiLy(), aLop(), aTieuDe(), Res$(), Res2(), dic As Object
  Dim sRow&, sCol&, i&, r&, iR&, j&, jC&, ngay, iKey$
 
  Set dic = CreateObject("Scripting.Dictionary")
  dic.comparemode = vbTextCompare
  With Sheets("Attendant")
    .Range("AL6:AS10000").ClearContents
    i = .Range("L" & Rows.Count).End(xlUp).Row
    If i < 6 Then Exit Sub
    aDaiLy = .Range("L6:L" & i).Value
    aLop = .Range("X6:Z" & i).Value
    aTieuDe = .Range("AN5:AS5").Value
  End With
  sRow = UBound(aLop):  sCol = UBound(aTieuDe, 2)
  ReDim Res(1 To sRow, 1 To 1)
  ReDim Res2(1 To sRow, 1 To sCol)
  For j = 1 To sCol
    dic.Item(aTieuDe(1, j)) = j
  Next j
  For i = 1 To sRow
    ngay = DateValue(Mid(aLop(i, 1), 7, 4) & Mid(aLop(i, 1), 3, 4) & Mid(aLop(i, 1), 1, 2))
    iKey = aDaiLy(i, 1)
    If Not dic.exists(iKey) Then
      r = r + 1
      dic.Add iKey, r
      Res(r, 1) = iKey
    End If
    iR = dic.Item(iKey):    jC = dic.Item(aLop(i, 3))
    iKey = aDaiLy(i, 1) & aLop(i, 3)
    If Not dic.exists(iKey) Then
      dic.Add iKey, ngay
      Res2(iR, jC) = ngay
    ElseIf ngay < dic.Item(iKey) Then
        dic.Item(iKey) = ngay
        Res2(iR, jC) = ngay
    End If
  Next i
  With Sheets("Attendant")
    .Range("AL6").Resize(r).Value = Res
    .Range("AN6").Resize(r, sCol).Value = Res2
    .Range("AN6").Resize(r, sCol).NumberFormat = "dd/mm/yyyy"
  End With
  Set dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
code bị báo lỗi bạn ơi.
Bạn xem nhé,

1622915185462.png

Với lại, nếu được, bạn xem giúp mình 3 cột mới phát sinh mà mình chưa nghĩ tới ở bài #1 (cột Z , cột AM và cột AT). Mình muốn tất cả những phần liệt kê bên dưới đều do code thực hiện, chứ làm bằng hàm rồi kéo xuống khoảng 300.000 dòng là file cực kỳ nặng, chạy không nổi luôn.
Nếu làm bằng code thì chỉ cần nhìn cột A xem dòng cuối cùng ở đâu thì thực hiện tới đó thôi, như vậy sẽ nhẹ file hơn rất nhiều

1. Cột Z : Z6=TRIM(SUBSTITUTE($W6," Class",""))&$Y6 : ghép loại lớp (cột W) với ngày chuyên đề (cột Y) lại thành lớp chuyên đề (bỏ phần " class" : có dấu cách phía trước) rồi fill down công thức xuống đến dòng cuối cùng (dựa theo cột A) .

2. Cột AL : copy cột L qua cột AL , lọc và bỏ đi những mã số trùng, fill down công thức xuống đến dòng cuối cùng (dựa theo cột A) .

3. Cột AM : đếm mã số đại lý (ở cột AL) , xem người này đã học tổng cộng bao nhiêu lớp SD (nếu cột AL trống thì khỏi đếm)
AM6=IF(LEN(AL6)<5,0,COUNTIFS($L$6:$L$300000,AL6,$W$6:$W$300000,"SD Class"))

4. Cột AN6:AS : tìm ra ngày học đầu tiên theo tên lớp đã học

Ví dụ học viên có mã số 0077252 đã học lớp SBW2 ,vào ngày 09/09/2016 và ngày 13/01/2017, vậy kết quả trả về ô AO7 phải là 09/09/2016 (ngày học lớp SBW2 ĐẦU TIÊN)

5. Cột AT : AT6=COUNTA(AN6:AS6) : đếm xem mã số đại lý (ở cột AL) đã học bao nhiêu lớp SBW

1622915654977.png
 

File đính kèm

  • book 1.xlsm
    5.7 MB · Đọc: 6
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

pupuchcha
  • Question
Viết code để tìm xích ma, mong mọi người giúp đỡ em ạ
Trả lời
1
Đọc
33
VetMini
V
Bich2B
lỗi định dạng ngày không đọc được công thức excel
Trả lời
9
Đọc
208
thaiduylamus
thaiduylamus
C
Giúp em viết công thức làm lịch thi đấu.
Trả lời
0
Đọc
20
caocat
C
D
Tính khoảng cách giữa 2 tọa độ?
Trả lời
4
Đọc
69
danhculao
D
K
Nhờ mọi người hỗ trợ giúp mình về tìm kiếm trong VBA. Mình sẽ gửi chút chi phí cafe cám ơn nhiều ạ
    • Cười
Trả lời
18
Đọc
312
VetMini
V
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