Các câu hỏi về hàm COUNTIF

Liên hệ QC
ST-Lu! đã viết:
Anh Kiệt ơi
Nếu file của em gần 20 ngàn dòng thì có lên sử dụng code này không?
------------
Em chưa test vì số liệu cập nhật sẽ tăng dần mỗi ngày


Cám ơn Anh
Nhấp chuột vào đây để mở rộng...
Sự kiện change phải cụ thể vào 1 cột, cell nào đó, nếu dữ liệu # 20.000 rows thì nên dùng sub thôi hay gán cho 1 phím gì đó thực thi code. Vì thay đổi code lại chạy => chậm.
 
ST-Lu! đã viết:
Anh Kiệt ơi
Nếu file của em gần 20 ngàn dòng thì có lên sử dụng code này không?
------------
Em chưa test vì số liệu cập nhật sẽ tăng dần mỗi ngày
Cám ơn Anh
Nhấp chuột vào đây để mở rộng...
Dĩ nhiên 20,000 dòng mà dùng sự kiện Worksheet_SelectionChange và vòng lặp 20,000 lần thì file nó chạy như thế nào là bạn biết rồi phải không? Mỗi lần chuyển con trỏ là code chạy quét 20,000 lần!?? +-+-+-+

Giải quyết bằng cách khác đi! Gợi ý tí:
- Có thể copy công thức hàng loạt sau đó paste value!
- Làm một nút command và chỉ chạy code khi click nút để check!
 
Lần chỉnh sửa cuối:
ST-Lu! đã viết:
Cám ơn bác Pi_kachu vô cùng Code của bác chạy rất ổn nhưng Code bác cho vào Module thì mỗi lần cập nhật em lại chạy code à St-Lu!
Nhấp chuột vào đây để mở rộng...
Có thể em hiểu sai ý chăng??!?!-0-/. Code này chạy được mà!
PHP: 
 Private Sub Worksheet_Change(ByVal Target As Range) Dim er As Long     er = [A65000].End(xlUp).Row         For i = 3 To er             If Cells(i, 1)  "" Then                 Cells(i, 2) = Application.CountIf(Range("A3:A" & er), Range("A" & i))                 Cells(i, 2).NumberFormat = "00"             End If         Next End Sub
Còn nếu quá nhiều thì đừng để chạy tự động mà hãy kích hoạt nó bằng tay thôi! Thân.
 
Lần chỉnh sửa cuối:
Anh Kiệt đã viết:
Dĩ nhiên 20,000 dòng mà dùng sự kiện Worksheet_SelectionChange và vòng lặp 20,000 lần thì file nó chạy như thế nào là bạn biết rồi phải không? Mỗi lần chuyển con trỏ là code chạy quét 20,000 lần!??

Giải quyết bằng cách khác đi!
Nhấp chuột vào đây để mở rộng...

Có khi em dùng công thức exel vụ này thôi vậy, có khi còn nhanh hơn Anh nhỉ?


Em vừa làm thử chút thì gặp lỗi sau
Tại ô nhập liệu, nếu ta bỏ trống một hàng ví dụ
- NHập liệu từ A1 --> A18
bỏ trống A19
Khi nhập liệu vào A20 thì dữ liệu tại ô B20 không chạy
------------
Có cách nào khắc phục không ạ??
 

File đính kèm

Lần chỉnh sửa cuối:
ca_dafi đã viết:
Po_Pikachu ơi! Code cũ bạn viết nó ngắn và chính xác hơn nhiều so với code trên đây, sao hổng xài vậy? Hãy giả sử đơn giản ta dùng công thức countif trên sheet đi, sẽ thấy:
|A|B|C 1|001|=Countif(A1:A$10,$A1)|=01 2|002|=Countif(A1:A$10,$A2)|=02 3|002|=Countif(A1:A$10,$A3)|=02 4|003|=Countif(A1:A$10,$A4)|=03 5|003|=Countif(A1:A$10,$A5)|=03 6|003|=Countif(A1:A$10,$A6)|=03 7|005|=Countif(A1:A$10,$A7)|=04 8|005|=Countif(A1:A$10,$A8)|=04 9|005|=Countif(A1:A$10,$A9)|=04 10|005|=Countif(A1:A$10,$A10)|=04
Từ đó suy ra code VBA cũng vậy thôi!
Nhấp chuột vào đây để mở rộng...
Em hỗng xài vì nó không có tính tăng dần. Bác xem file sẽ thấy 7 con số 01 ở lần xuất hiện đầu tiên đó. Thân.
 
Lần chỉnh sửa cuối:
ST-Lu! đã viết:
Em thử viết một code để học như sau nhưng sai nè không chạy được
--> công việc là tự động countif lại mỗi lần tại cột B khi ta thêm dữ liệu vào cột A

Xin các Anh chỉ cho
Nhấp chuột vào đây để mở rộng...

Dùng thử đoạn code này xem sao (Test thử thì thấy rất OK)
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
With Application
    If Target.Column = 1 Then
    Set Rng = Range([a3], [a65000].End(xlUp))
        For Each Clls In Rng
            Clls.Offset(, 1) = .CountIf(Rng, Clls)
        Next
    End If
End With
End Sub
 
ST-Lu! đã viết:
Có khi em dùng công thức exel vụ này thôi vậy, có khi còn nhanh hơn Anh nhỉ? Em vừa làm thử chút thì gặp lỗi sau Tại ô nhập liệu, nếu ta bỏ trống một hàng ví dụ - NHập liệu từ A1 --> A18 bỏ trống A19 Khi nhập liệu vào A20 thì dữ liệu tại ô B20 không chạy ------------ Có cách nào khắc phục không ạ??
Nhấp chuột vào đây để mở rộng...
Hổng chạy là phải rồi! Bạn đặt chức năng nếu ô Cells(i,1) mà rỗng thì code dừng lại đó.
Mã: 
If [COLOR=red]Cells(i, 1)  ""[/COLOR] Then ... [COLOR=red]Else: Exit Sub[/COLOR]
Vậy hỏi xem bạn có cần tính chất này không? Không cần thì viết như vầy:
PHP: 
Sub Test() Dim eR As Long eR = [A65000].End(xlUp).Row     For i = 1 To eR             Cells(i, 2) = Application.CountIf(Range("A1:A" & eR), Range("A" & i))             Cells(i, 2).NumberFormat = "00"     Next End Sub
Thân.
 
Lần chỉnh sửa cuối:
ST-Lu! đã viết:
Có khi em dùng công thức exel vụ này thôi vậy, có khi còn nhanh hơn Anh nhỉ?


Em vừa làm thử chút thì gặp lỗi sau
Tại ô nhập liệu, nếu ta bỏ trống một hàng ví dụ
- NHập liệu từ A1 --> A18
bỏ trống A19
Khi nhập liệu vào A20 thì dữ liệu tại ô B20 không chạy
------------
Có cách nào khắc phục không ạ??
Nhấp chuột vào đây để mở rộng...
Cái này là do đoạn tô đậm màu đỏ này, bỏ đoạn đó đi là xong:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim er As Long
er = [A65000].end(xlup).row
For i = 1 To er
If Cells(i,1) <> "" Then
Cells(i,2)= Application.WorksheetFunction.CountIf(Range("A1:A" & er), Range("A" & i)) ''<==Sửa chỗ này
Else: Exit Sub <== Bỏ đoạn này đi là xong
End If
Next
End Sub
Nhấp chuột vào đây để mở rộng...
 
Code của anh Khải hay thật đó, không cần đặt ở module
Ẹc ẹc
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
With Application
    If Target.Column = 1 Then
    Set Rng = Range([a3], [a65000].End(xlUp))
        For Each clls In Rng
            If clls <> "" Then
            clls.Offset(, 1) = .CountIf(Rng, clls)
            Else
            clls.Offset(, 1) = ""
            End If
        Next
    End If
End With
End Sub
Cám ơn các Anh

Cám ơn Anh Kiệt, Anh Pi_Kachu, Anh Thu Nghi, Anh Khải... rất nhiều về sự giúp đỡ


Một lần nữa xin cám ơn các Anh rất nhiều


ST-Lu!
 
Lần chỉnh sửa cuối:
Em xin lỗi vì lài dài dòng một chút
1. Em thử chạy code của Pi_kachu với File khoảng 1500 dòng

Tại Module
PHP: 
Sub Test()
Dim eR As Long
eR = [A65000].End(xlUp).Row
    For i = 1 To eR
            Cells(i, 13) = Application.CountIf(Range("A1:A" & eR), Range("A" & i))
            Cells(i, 13).NumberFormat = "00"
    Next
End Sub
Tại Sheet
PHP: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Test
End Sub

File chạy rất lâu, mỗi lần thay đổi, di chuyển chờ vài phút
--------------------------------
Code của Anh Boyxin khá hơn
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
With Application
    If Target.Column = 1 Then
    Set Rng = Range([a3], [a65000].End(xlUp))
        For Each Clls In Rng
            Clls.Offset(, 1) = .CountIf(Rng, Clls)
        Next
    End If
End With
End Sub

Nhưng chạy cũng lâu

Em gửi File các Anh Test thử nhé
-----------------
Nếu VBA thế này thì em phải dùng công thức Excel vậy thôi

Cám ơn các Anh
 

File đính kèm

To Po_Pikachu.

PHP: 
Sub Test() 
Dim eR As Long 
eR = [A65000].End(xlUp).Row 
    For i = 1 To eR 
1           Cells(i, 13) = Application.CountIf(Range("A1:A" & eR), Range("A" & i)) 
2            Cells(i, 13).NumberFormat = "00" 
    Next 
End Sub
Mình nghĩ dòng lệnh 2 có thể để ngoài vòng lặp & 'Làm' 1 lần toàn cột!?!​



 
COUNTIF in VBA

ST-Lu! đã viết:
Em xin lỗi vì lài dài dòng một chút
1. Em thử chạy code của Pi_kachu với File khoảng 1500 dòng
File chạy rất lâu, mỗi lần thay đổi, di chuyển chờ vài phút
--------------------------------
Code của Anh Boyxin khá hơn
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
With Application
    If Target.Column = 1 Then
    Set Rng = Range([a3], [a65000].End(xlUp))
        For Each Clls In Rng
            Clls.Offset(, 1) = .CountIf(Rng, Clls)
        Next
    End If
End With
End Sub
Nhưng chạy cũng lâu

Em gửi File các Anh Test thử nhé
Nhấp chuột vào đây để mở rộng...

Thay bằng đoạn code này sẽ thấy cải thiện hơn rất nhiều (chớp mắt xong thì cũng đếm xong)
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
With Application
    .DisplayAlerts = False
    .Calculation = xlCalculationManual
    If Target.Column = 1 Then
    Set Rng = Range([a10], [a65000].End(xlUp))
    Tmp = Rng.Offset(, 1)
        For Each Clls In Rng
            Tmp(Clls.Row - 9, 1) = .CountIf(Rng, Clls)
        Next
    Rng.Offset(, 1) = Tmp
    End If
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With
End Sub
 
Lần chỉnh sửa cuối:
Tôi thì làm vầy:
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
   Application.ScreenUpdating = False
   With Range([A9], [A65000].End(xlUp))
     If Not Intersect(.Cells, Target) Is Nothing Then
       .Offset(, 1).FormulaArray = "=COUNTIF(" & .Cells.Address & "," & .Cells.Address & ")"
       With .Offset(, 1)
         .Value = .Value: .NumberFormat = "00"
         .AutoFilter 1, "=00"
         .SpecialCells(12).ClearContents
       End With
     End If
   End With
   ActiveSheet.AutoFilterMode = False
End Sub
Với 1500 dòng dử liệu mà For thì đến bao giờ mới xong!
Thử code này xem có cải thiện được tốc độ không nha
Nói thêm: Tôi nghĩ code này không nên đặt vào sự kiện change, chỉ tổ phí thời gian ---> Nên cho vào 1 sub ---> Khi nhập liệu xong, chạy code 1 lần duy nhất cho khỏe
 

File đính kèm

Lần chỉnh sửa cuối:
ndu96081631 đã viết:
Tôi thì làm vầy:
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
   Application.ScreenUpdating = False
   With Range([A9], [A65000].End(xlUp))
     If Not Intersect(.Cells, Target) Is Nothing Then
       .Offset(, 1).FormulaArray = "=COUNTIF(" & .Cells.Address & "," & .Cells.Address & ")"
       With .Offset(, 1)
         .Value = .Value: .NumberFormat = "00"
         .AutoFilter 1, "=00"
         .SpecialCells(12).ClearContents
       End With
     End If
   End With
   ActiveSheet.AutoFilterMode = False
End Sub
Với 1500 dòng dử liệu mà For thì đến bao giờ mới xong!
Thử code này xem có cải thiện được tốc độ không nha
Nói thêm: Tôi nghĩ code này không nên đặt vào sự kiện change, chỉ tổ phí thời gian ---> Nên cho vào 1 sub ---> Khi nhập liệu xong, chạy code 1 lần duy nhất cho khỏe
Nhấp chuột vào đây để mở rộng...

Nếu dùng công thức thì có thể dùng cách này cũng nhanh
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
With Application
    .DisplayAlerts = False
    .Calculation = xlCalculationManual
If Target.Column = 1 Then
    With Range([a10], [a65535].End(xlUp))
        .Offset(, 1).Formula = "=if(rc[-1]="""","""",countif(" & .Address(, , 2) & ",rc[-1]))"
        .Offset(, 1) = .Offset(, 1).Value
    End With
End If
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With
End Sub
 
Cải tiến thêm 1 bước nữa, khỏi cần AutoFilter luôn ---> Đương nhiên tốc độ cũng sẽ nhanh hơn
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim RgAr As String
  With Range([A9], [A65000].End(xlUp))
    RgAr = .Address
    If Not Intersect(.Cells, Target) Is Nothing Then
      .Offset(, 1).FormulaArray = "=IF(" & RgAr & "= """",""""," & "COUNTIF(" & RgAr & "," & RgAr & "))"
      .Offset(, 1).Value = .Offset(, 1).Value
      .Offset(, 1).NumberFormat = "00"
    End If
  End With
End Sub
--------------------
Ẹc... Ẹc... Vừa post xong đã thấy Boyxin post trước y chang...
 

File đính kèm

Cải tiến lần nữa ---> Bỏ luôn công đoạn chuyển công thức thành giá trị
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim RgAr As String
   With Range([A9], [A65000].End(xlUp))
     RgAr = .Address
     If Not Intersect(.Cells, Target) Is Nothing Then
       .Offset(, 1).Value = Evaluate("=IF(" & RgAr & "= """",""""," & "COUNTIF(" & RgAr & "," & RgAr & "))")
       .Offset(, 1).NumberFormat = "00"
     End If
   End With
End Sub
Xong ---> Hy vọng không còn gì để cải tiến nữa
Ẹc... Ẹc....
 

File đính kèm

ST-Lu! đã viết:
Anh Kiệt ơi
Nếu file của em gần 20 ngàn dòng thì có lên sử dụng code này không?
------------
Em chưa test vì số liệu cập nhật sẽ tăng dần mỗi ngày


Cám ơn Anh
Nhấp chuột vào đây để mở rộng...

Nếu rất nhiều dòng (20.000 gì đó) mà chạy lại toàn bộ thì chỉ có chết. Hãy thử cách sau:

- Mỗi khi có sự thay đổi một Cell thuộc cột A, ghi lại giá trị cũ và mới (OldValue; NewValue)
- Dùng phương thức Find đếm từ Cell vừa thay đổi đến hàng cuối cùng :
+ Nếu trùng với OldValue thì Cell bên cột B sẽ giảm đi 1

+ Nếu trùng với NewValue thì Cell bên cột B sẽ tăng lên 1
​
Thử xem nhé.

--Chúc vui--
 
Ý bạn nói là như vậy hả?
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next    If Target.Column = 1 And Target.Value  "" Then    Target.Offset(, 1).Value = Application.CountIf(Range("A:A"), Target.Value)    Target.Offset(, 1).NumberFormat = "00"    ElseIF Target.Column = 1 And Target.Value = "" Then    Target.Offset(, 1).Value = ""    End If End Sub
Thân
 
Lần chỉnh sửa cuối:
Lệnh Hồ Đại Hiệp đã viết:
Nếu rất nhiều dòng (20.000 gì đó) mà chạy lại toàn bộ thì chỉ có chết. Hãy thử cách sau:

- Mỗi khi có sự thay đổi một Cell thuộc cột A, ghi lại giá trị cũ và mới (OldValue; NewValue)
- Dùng phương thức Find đếm từ Cell vừa thay đổi đến hàng cuối cùng :
+ Nếu trùng với OldValue thì Cell bên cột B sẽ giảm đi 1

+ Nếu trùng với NewValue thì Cell bên cột B sẽ tăng lên 1
​
Thử xem nhé.

--Chúc vui--
Nhấp chuột vào đây để mở rộng...

Thực ra với yêu cầu đếm như bài này thì có nhiều cách

Tác giả muốn hỏi VLOOKUP trong VBA thế nào thì mọi người làm như vậy thôi. Nếu hỏi Đếm thế nào thì dùng FIND (như Lệnh Hồ Đại Hiệp nói) là nhanh nhất rồi
 
Dùng hàm Find mà dữ liệu nhiều cũng chậm lắm đó bác à! Vì hàm Find chạy theo quy tắc hàng trước, dọc sau, quét từ trái sang phải - từ trên xuống dưới. Nên 20,000 dòng thì bác có thể đếm được bao nhiêu ô dữ liệu rồi đúng không? Thân.
 
Lần chỉnh sửa cuối:
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

Momominh
Hỏi công thức tìm kiếm
Trả lời
2
Đọc
13
thuytrangbp28
T
huongmuine
Điền số thứ tự theo nhóm có điều kiện
Trả lời
4
Đọc
34
huongmuine
huongmuine
Mewwo98
Thay dấu ngăn cách sau chữ số hàng nghìn, hàng triệu, hàng tỷ trong Mail Merge
Trả lời
12
Đọc
214
HeSanbi
HeSanbi
K
  • Question Question
BÀI TOÁN TÌM GIÁ USD VÀ TÌM LƯỢNG KG - NHỜ ANH/CHỊ GIÚP ĐỠ
    • Chấp nhận
Trả lời
3
Đọc
36
VetMini
V
H
Nhờ các bạn mở quá công thức của các sheet
Trả lời
3
Đọc
50
VetMini
V
Y
Không copy được dữ liệu sang sheet khac
Trả lời
12
Đọc
24K
leduchien1001
L
A
Kính nhờ xử lý nhập công thức hàm IF kết hợp nhiều điều kiện
Trả lời
0
Đọc
13
aka_8x
A
S
Lỗi Path/File access error:'.\VBFB.tmp'
Trả lời
10
Đọc
4K
dhtq159
D
N
Vẽ đường tròn bám theo 1 Polyline
Trả lời
4
Đọc
57
nguyenvanvien
N
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
    • Thích
Trả lời
3
Đọc
137
trung_bhxh
T
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
311
Đọc
23K
kunkoi9390
K
GPE-Trợ Lý
KHÓA HỌC BỨT PHÁ KỸ NĂNG EXCEL
    • Thích
    • Yêu thích
Trả lời
4
Đọc
1K
GPE-Trợ Lý
GPE-Trợ Lý
OverAC
TPHCM - Gặp mặt đầu năm Ất Tỵ 18g ngày 8/2
    • Thích
    • Ngạc nhiên
Trả lời
1
Đọc
85
tungnguyen_kt
tungnguyen_kt
ptm0412
  • Question Question
Cách lấy link file excel nguồn cho Power query từ Onedrive, Google drive
    • Thích
    • Yêu thích
Trả lời
7
Đọc
3K
pxhieu1993
P
Y
Nhờ các anh chị xem giúp Hàm Sumproduct
Trả lời
0
Đọc
33
yoomi
Y
dinhnhat91
  • Question Question
VBA Lỗi runtime error 9 subscript out of range
Trả lời
4
Đọc
107
ongke0711
ongke0711
GPE-Trợ Lý
[GPE] TALK SHOW EXCEL TRONG SẢN XUẤT
    • Thích
Trả lời
1
Đọc
563
PhanTuHuong
PhanTuHuong
Việt Nguyễn 86
Excel hay bị tắt đột ngột và hiện trang trắng khi làm việc
Trả lời
0
Đọc
65
Việt Nguyễn 86
Việt Nguyễn 86
K
Mong giúp dữ liệu từ trang web sang excel
Trả lời
0
Đọc
60
khanhvinhdai1
K
T
Bảng tính trợ cấp tinh giản biên chế theo NĐ 108
    • Thích
Trả lời
3
Đọc
1K
trung_bhxh
T
Xem thêm…

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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới Ất Tỵ 2025
Back
Top Bottom