toandiennuoc123
Thành viên thường trực




- Tham gia
- 7/3/12
- Bài viết
- 239
- Được thích
- 9
Chào các bạn ! Tôi có bài này muốn nhờ các bạn giúp đỡ. Các bạn xem file đính kèm. Xin cám ơn
Sub GPE_tim()
Dim rng As Range, vung As Range, ArrSTT As Range
Set vung = Range("C3:C1000")
Set ArrSTT = Range([A65536].End(xlUp), [A3])
'nho' unhide row truoc khi copy
Application.ScreenUpdating = False
ArrSTT.Offset(, 1).ClearContents '<=>Range("B3:B102").ClearContents
For Each rng In ArrSTT
If rng <> "" Then
x = Application.WorksheetFunction.CountIf(vung, rng)
If x > 0 Then rng.Offset(, 1) = x
End If
Next
Application.ScreenUpdating = True
End Sub
bạn chạy thử code sau:
Mã:Sub GPE_tim() Dim rng As Range, vung As Range, ArrSTT As Range Set vung = Range("C3:C1000") Set ArrSTT = Range([A65536].End(xlUp), [A3]) 'nho' unhide row truoc khi copy Application.ScreenUpdating = False ArrSTT.Offset(, 1).ClearContents '<=>Range("B3:B102").ClearContents For Each rng In ArrSTT If rng <> "" Then x = Application.WorksheetFunction.CountIf(vung, rng) If x > 0 Then rng.Offset(, 1) = x End If Next Application.ScreenUpdating = True End Sub
Thêm 1 Sub "tà đạo" nữa nè:Hiện tại đang chạy ngon lành, Cám ơn bạn nhiều !
Sub t()
arr = WorksheetFunction.Frequency(Range([C3], [C65536].End(xlUp)), Range([A3], [A65536].End(xlUp)))
For I = LBound(arr) To UBound(arr)
If arr(I, 1) = 0 Then arr(I, 1) = "" ' loại các ô không có trị số
Next I
[B3].Resize(UBound(arr) - LBound(arr)) = arr
End Sub
@phucbugis: Bài này giản dị là đếm frequency mà. Tại chủ thớt không rõ vấn đề nên thành ra rườm rà.
Nếu đã dùng hàm worksheet thì dùng thẳng hàm frequency luôn cho gọn.
Mã:Sub t() arr = WorksheetFunction.Frequency(Range([C3], [C65536].End(xlUp)), Range([A3], [A65536].End(xlUp))) For I = LBound(arr) To UBound(arr) If arr(I, 1) = 0 Then arr(I, 1) = "" ' loại các ô không có trị số Next I [B3].Resize(UBound(arr) - LBound(arr)) = arr End Sub