Làm thế nào để đếm số lần xuất hiện của 1 chữ số (ký tự) cụ thể?

[son.0985221400]

Tôi có một bảng tính gồm nhiều ô VD:
A1: 1111; A2: 12541; A3: 11....
B1:10; B2:145124; B3: 1245179......
........................
Nay tôi muốn làm một macro hay là dùng hàm gì đó để có thể
1. Đếm số lần xuất hiện của chữ số cụ thể nào đó trong bảng tính (VD ở trên đã có 13 lần xuất hiện của chữ số 1, 1 lần xuất hiện của chữ số 0... ) 2. Liệt kê xem số nào xuất hiện nhiều nhất, số nào xuất hiện ít nhất.
Mong các sư phụ chỉ giáo



chân thành cảm ơn

 

[BNTT]

Tôi có một bảng tính gồm nhiều ô VD:
A1: 1111; A2: 12541; A3: 11....
B1:10; B2:145124; B3: 1245179......
........................
Nay tôi muốn làm một macro hay là dùng hàm gì đó để có thể:
1. Đếm số lần xuất hiện của chữ số cụ thể nào đó trong bảng tính (VD ở trên đã có 13 lần xuất hiện của chữ số 1, 1 lần xuất hiện của chữ số 0... )

Trả lời câu 1:

=SUMPRODUCT(--LEN(A1:B3)) - SUMPRODUCT(--LEN(SUBSTITUTE(A1:B3,E1,"")))​

Con số bạn cần đếm, nhập vào trong E1.
Ví dụ, muốn đếm số 1, nhập 1 vào trong E1, muốn đếm số 2, nhập 2 vào trong E1...

Trả lời vậy cho lẹ. Chứ có thể còn có công thức khác, ngắn hơn...

 

[hoangvuluan]

Có thể dùng thử hàm đếm số các kí số trong 1 khoảng như sau:

Function nCount(rng As Range, Optional dir As Boolean = True) As Variant
Dim a(0 To 9) As Long
Dim ce As Range
    
    For Each ce In rng
        If IsNumeric(ce) Then
            s = CStr(ce)
            For i = 1 To Len(s)
                a(Mid(s, i, 1)) = a(Mid(s, i, 1)) + 1
            Next
        End If
    Next
    
    If dir Then
        nCount = WorksheetFunction.Transpose(a)
    Else
        nCount = a
    End If
End Function

Lưu ý cách dùng:
1. Đưa hàm nCount vào Module của VBA
2. Để sử dụng hàm, trước hết chọn 10 ô (chọn dọc thì không cần đối số thứ 2, chọn 10 ô theo hàng thì dùng đối số thứ hai với giá trị 0 hoặc False), nhập công thức: = nCount(vùng_đếm) và nhấn Ctrl-Shift-Enter - vì đây là hàm mảng trả về 10 giá trị.

Ví dụ: chọn 10 ô A1:J1, nhập = nCount($A$2:$C$15, False) và nhấn Ctrl-Shift-Enter
hoặc chọn 10 ô A1:A10, nhập = nCount($A$2:$C$15) và nhấn Ctrl-Shift-Enter

 

[anhtuan1066]

Có thể dùng thử hàm đếm số các kí số trong 1 khoảng như sau:

Function nCount(rng As Range, Optional dir As Boolean = True) As Variant
Dim a(0 To 9) As Long
Dim ce As Range
 
    For Each ce In rng
        If IsNumeric(ce) Then
            s = CStr(ce)
            For i = 1 To Len(s)
                a(Mid(s, i, 1)) = a(Mid(s, i, 1)) + 1
            Next
        End If
    Next
 
    If dir Then
        nCount = WorksheetFunction.Transpose(a)
    Else
        nCount = a
    End If
End Function

Lưu ý cách dùng:
1. Đưa hàm nCount vào Module của VBA
2. Để sử dụng hàm, trước hết chọn 10 ô (chọn dọc thì không cần đối số thứ 2, chọn 10 ô theo hàng thì dùng đối số thứ hai với giá trị 0 hoặc False), nhập công thức: = nCount(vùng_đếm) và nhấn Ctrl-Shift-Enter - vì đây là hàm mảng trả về 10 giá trị.

Ví dụ: chọn 10 ô A1:J1, nhập = nCount($A$2:$C$15, False) và nhấn Ctrl-Shift-Enter
hoặc chọn 10 ô A1:A10, nhập = nCount($A$2:$C$15) và nhấn Ctrl-Shift-Enter

For i = 1 To Len(s) là quét toàn bộ các ký tự trong chuổi... Tôi nghĩ ko hay lắm... Sao ban ko dùng REPLACE thay số cần tìm thành rổng, lấy độ dài của chuổi gốc so sánh với độ dài chuổi sau khi thay thế sẽ tìm ra dc số lượng ký tự
Và có thể cũng ko cần công đoạn kiểm tra cell có phải là Number hay ko !!!

 

[ThuNghi]

For i = 1 To Len(s) là quét toàn bộ các ký tự trong chuổi... Tôi nghĩ ko hay lắm... Sao ban ko dùng REPLACE thay số cần tìm thành rổng, lấy độ dài của chuổi gốc so sánh với độ dài chuổi sau khi thay thế sẽ tìm ra dc số lượng ký tự
Và có thể cũng ko cần công đoạn kiểm tra cell có phải là Number hay ko !!!

Nhớ rằng khi replace thì nhớ đừng thay đổi dữ liệu nhé.
Tôi cũng tham gia thử 1 function.

Option Explicit
Function CountSo(MyRng As Range, so As Byte)
Dim i As Long, dodai01 As Long, dodai02 As Long, iText As String
dodai01 = 0: dodai02 = 0
For i = 1 To MyRng.Count
    iText = Trim(MyRng(i))
    If InStr(1, iText, so) Then
        dodai01 = dodai01 + Len(iText)
        iText = Replace(iText, so, "")
        dodai02 = dodai02 + Len(iText)
    End If
Next
CountSo = dodai01 - dodai02
End Function

Cú pháp: CountSo(A1:B100,x)
x là số cần đếm.

 

[anhtuan1066]

Nhớ rằng khi replace thì nhớ đừng thay đổi dữ liệu nhé.
Tôi cũng tham gia thử 1 function.

Option Explicit
Function CountSo(MyRng As Range, so As Byte)
Dim i As Long, dodai01 As Long, dodai02 As Long, iText As String
dodai01 = 0: dodai02 = 0
For i = 1 To MyRng.Count
    iText = Trim(MyRng(i))
    If InStr(1, iText, so) Then
        dodai01 = dodai01 + Len(iText)
        iText = Replace(iText, so, "")
        dodai02 = dodai02 + Len(iText)
    End If
Next
CountSo = dodai01 - dodai02
End Function

Cú pháp: CountSo(A1:B100,x)
x là số cần đếm.

Cũng đâu cần nhiều biến đến thế ThuNghi
Tôi thì làm vầy:

Function CountText(Rng As Range, Text As String) As Long
  Dim Clls As Range
  For Each Clls In Rng
   CountText = CountText + (Len(Clls) - Len(Replace(Clls, Text, ""))) / Len(Text)
  Next
End Function

Nhớ phải có đoạn / Len(Text) để dự phòng trường hợp chuổi tìm từ 2 ký tự trở lên

 

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

Excel có phương thức Replace(All) rất mạnh, mỗi khi chạy xong là nó sẽ báo số lần Replace (Msgbox). Nếu lấy được Nội dung của Msgbox này thì vấn đề tốc độ được giải quyết.

Code của bác NDU rất sáng tạo, tuy nhiên nếu xét từng Clls thì hơi mất công, hãy lợi dụng Find để tìm xem Clls có chứa (những) ký tự đó, sau đó mới xét đến hàm replace.
Khi dữ liệu nhiều thì sẽ thấy ngay sự khác biệt về tốc độ

--Chúc vui--

 

[anhtuan1066]

nếu xét từng Clls thì hơi mất công, hãy lợi dụng Find để tìm xem Clls có chứa (những) ký tự đó, sau đó mới xét đến hàm replace.
Khi dữ liệu nhiều thì sẽ thấy ngay sự khác biệt về tốc độ

--Chúc vui--

Tôi có nghĩ qua vấn đề bỏ qua vòng lập, và tôi cải tiến như sau:

Function CountText(Rng As Range, Text As String) As Long
  Dim ForString As String
  With Rng
    ForString = "=SUM(LEN(" & .Address & ")-LEN(SUBSTITUTE(" & .Address & "," & Chr(34) & Text & Chr(34) & ","""")))"
    CountText = Evaluate(ForString) / Len(Text)
  End With
End Function

Đã thử nghiệm dử liệu 50.000 cell, tốc độ gần như tức thì