Option Explicit
Sub Dém()
Dim WF As Object, Cls As Range, Rng As Range
Set WF = Application.WorksheetFunction
Set Rng = Range([A1], [A1].End(xlDown))
Rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"D1"), Unique:=True
For Each Cls In Range([d2], [d2].End(xlDown))
[h2].Value = Cls.Value
Cls.Offset(, 1).Value = WF.DCountA(Rng, [A1], [H1:H2])
Next Cls
[E2].Resize(Rng.Rows.Count).Interior.ColorIndex = 2
Columns("D:E").Select
Selection.Sort Key1:=Range("E2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1
[D7].Resize(Rng.Rows.Count, 2).Font.ColorIndex = 2
[E2].Resize(5).Interior.ColorIndex = 38
[c2].Select
End Sub
Có những trường hợp phải cho biết xử lý thế nào:
6
Có thể dùng sự kiện trong sheet để khi thay đổi ở cột A thì code chạy cho kết quả ở cột DEm cảm ơn bác nhé đúng ý em rồi hiiii
Tuy nhiên em hơi làm phiền bác chút nhé "Được voi đòi hai bà Trưng chút" em muốn một hàm mà không cầm phải tạo nút bấm có được không ạ VD khi em copy dữ liệu cần lấy vào Ô A1:A.... và 5 cây được lấy ra ghi tại Ô D2
Cảm ơn anh!
Public Function NamCay(Vung As Range)
Dim d, Wf, I, J, K, kK, A, Tam, Kq(1 To 5, 1 To 2)
Set d = CreateObject("scripting.dictionary")
Set Wf = Application.WorksheetFunction
ReDim Tam(1 To Vung.Rows.Count, 1 To 2)
For I = 1 To Vung.Rows.Count
If Len(Vung(I)) Then
If Not d.exists(Vung(I).Value) Then
K = K + 1
d.Add Vung(I).Value, Wf.CountIf(Vung, Vung(I))
Tam(K, 1) = Vung(I): Tam(K, 2) = Wf.CountIf(Vung, Vung(I))
End If
End If
Next I
For I = 1 To 5
A = Wf.Large(d.items, I)
For J = 1 To K
If Tam(J, 2) = A Then Kq(I, 1) = Tam(J, 1): Kq(I, 2) = A: Tam(J, 2) = 0: Exit For
Next J
Next I
NamCay = Kq
End Function1)- Trên diễn đàn rất nhiều anh em tự học và học lẫn nhau viết rất giỏi, nếu thích & cố gắng theo một thời gian vài tháng bạn cũng viết được thôi
Public Function NamCay(Vung As Range)
Dim d, Wf, I, J, K, kK, A, Tam, Kq(1 To 5, 1 To 2)
Set d = CreateObject("scripting.dictionary")
Set Wf = Application.WorksheetFunction
ReDim Tam(1 To Vung.Rows.Count, 1 To 2)
For I = 1 To Vung.Rows.Count
If Len(Vung(I)) Then
If Not d.exists(Vung(I).Value) Then
K = K + 1
d.Add Vung(I).Value, Wf.CountIf(Vung, Vung(I))
Tam(K, 1) = Vung(I): Tam(K, 2) = Wf.CountIf(Vung, Vung(I))
End If
End If
Next I
[COLOR=#ff0000]For I = 1 To d.Count '5[/COLOR]
A = Wf.Large(d.items, I)
For J = 1 To K
If Tam(J, 2) = A Then Kq(I, 1) = Tam(J, 1): Kq(I, 2) = A: Tam(J, 2) = 0: Exit For
Next J
Next I
NamCay = Kq
End FunctionEm cảm ơn anh! Tuy nhiên khi em thử thì nó không chạy anh có thể kiểm tra lại giúp em nhé. Khi em chọn trong list danh sách thì cũng không được
)
Không phản hồi vì có lý do của nó.
Em cảm ơn anh Ba Tê đã góp ý không thấy có ai phản hồi nên em không biết thế nào để giải thích có sự đóng góp của anh thì em mới biết.
- Đã "chuẩn không cần chỉnh" thì không chỉnh nữa.
Anh Ba Tê và các thành viên trến diễn đàn giúp em với chương trình này với ạ
