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

[ThuNghi]

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

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.

 

[cadafi]

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

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!

 

[Po_Pikachu]

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!

Có thể em hiểu sai ý chăng??!?! Code này chạy được mà!

 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.

 

[ST-Lu!]

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!

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 ạ??

 

[Po_Pikachu]

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!

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.

 

[boyxin]

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

Dùng thử đoạn code này xem sao (Test thử thì thấy rất OK)

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

 

[Po_Pikachu]

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 ạ??

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 đó.

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:

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.

 

[cadafi]

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 ạ??

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

 

[ST-Lu!]

Code của anh Khải hay thật đó, không cần đặt ở module
Ẹc ẹc

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!

 

[ST-Lu!]

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

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

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

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

 

[ChanhTQ@]

To Po_Pikachu.

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!?!​

 

[boyxin]

COUNTIF in VBA

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

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é

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)

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

 

[ndu96081631]

Tôi thì làm vầy:

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

 

[boyxin]

Tôi thì làm vầy:

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

Nếu dùng công thức thì có thể dùng cách này cũng nhanh

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

 

[ndu96081631]

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

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...

 

[ndu96081631]

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ị

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....

 

[Lệnh Hồ Đại Hiệp]

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

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--

 

[Po_Pikachu]

Ý bạn nói là như vậy hả?

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

 

[boyxin]

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--

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

 

[Po_Pikachu]

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.