Có cách nào đếm 1 ký tự trong chuỗi bằng VBA ko?

[Po_Pikachu]

Ví dụ như ta có 1 chuỗi: 15/A5/530/BC5/156/AC5.... Vậy làm sao để đếm được có bao nhiêu dấu (/) trong chuỗi này?

 

[ndu96081631]

Ví dụ như ta có 1 chuỗi: 15/A5/530/BC5/156/AC5.... Vậy làm sao để đếm được có bao nhiêu dấu (/) trong chuỗi này?

Đương nhiên là được! Dùng công thức thì dựa và hàm MID, dùng VBA cũng thế!
Một gợi ý cho bạn:

Option Explicit
Function DemKT(Clls As Range, Kd As String) As Integer
   Dim i, K As Integer
   K = 0
   For i = 1 To Len(Clls.Value)
      If Mid(Clls.Value, i, 1) = Kd Then
         K = K + 1
      End If
   Next
   DemKT = K
End Function

-Gọi hàm
-Clls là cell chứa chuổi cần đếm
-Kd là điều kiện đếm, ở đây là ký tự "/"
Giã sử chuổi nằm tại A1, ta có hàm:

=DemKT(A1,"/")

File đính kèm tôi làm 2 cách: bằng công thức thường và bằng VBA

 

[SA_DQ]

Dùng hàm này sẽ ngắn hơn tẹo! Do hỗ trợ từ InStr()

Option Explicit
Function CountAll(Clls As Range, StrC As String) As Byte
 Dim VTr As Byte
 Do
    VTr = InStr(VTr + 1, Clls.Value, StrC)
    If VTr = 0 Then Exit Function
    CountAll = CountAll + 1
 Loop
End Function

 

[ndu96081631]

Ngắn hơn nữa nè (chạy đua vũ trang)

Option Explicit
Function DemKT(Clls As Range, Kd As String) As Integer
   Dim K1, K2 As Integer
   K1 = Len(Clls.Value)
   K2 = Len(Application.WorksheetFunction.Substitute(Clls.Value, Kd, ""))
   DemKT = K1 - K2
End Function

Hoặc công thức cũng ngắn hơn:

=LEN($A2)-LEN(SUBSTITUTE($A2,"/",""))

 

[Po_Pikachu]

A, anh bạn ndu96081631 đã giành chiến thắng nhưng cuộc đua vẫn chưa dành kúp vô địch! Vì không biết ai có khả năng lên đàn dành chức "Võ lăm minh chủ" không? Thì cùng thách đấu với ndu96081631. Cảm ơn bạn nhiều nha!

 

[ndu96081631]

A, anh bạn ndu96081631 đã giành chiến thắng nhưng cuộc đua vẫn chưa dành kúp vô địch!
Vì không biết ai có khả năng lên đàn dành chức "Võ lăm minh chủ" không? Thì cùng thách đấu với ndu96081631.

Cảm ơn bạn nhiều nha!

Cảm ơn bạn!
Nhưng xin đừng nói thế!
Diển đàn này nhân tài nhiều vô số kể. Tôi đang học, không dám múa rìu với anh SA_DQ.
Chỉ là tình cờ phát hiện giãi pháp ngắn thì đưa lên thôi

 

[Po_Pikachu]

Em nói đùa chút thôi, mong mọi người đừng giận nha! Vì em nghiền ngẩm mãi hông ra mà lại có nhiều cách giải quá! Lại còn cực ngắn nữa chứ! Quả thật là khâm phục sát đất! (Nếu có đụng chạm ai thì cho em xin lỗi nha! Chúc mọi người 1 ngày lành).

 

[SA_DQ]

Em nói đùa chút thôi, mong mọi người đừng giận nha!
.

Các chú mầy khéo lo xa!
Chỉ sợ một điều trẻ không vượt được già thôi; Chứ vượt được là điều hiển nhiên & cộng đồng & XH có phước hơn í chứ!

Đưa vô đây vài số liệu, các bạn tham khảo:
Với hơn 2.000 dòng dữ liệu xen kẻ 5 & 10 dấu "/";
macro của mình viết lại hao mất gần .35 gy - của NDU tối đa chỉ .25 gy!

 

[ptm0412]

Không dám đua tranh nhưng dùng hàm replace() của VBA thay cho hàm substitute() của Excel thì ngắn hơn 1 tẹo. Tốc độ thì không biết, thuật toán giữ nguyên của Ndu

Function DemKT(Clls As Range, Kd As String) As Integer
   Dim K1, K2 As Integer
   K1 = Len(Clls.Value)
   K2 = Len(Replace(Clls.Value, Kd, ""))
   DemKT = K1 - K2
End Function

 

[SA_DQ]

2uán quân hiện hành: .203125 gy

Không dám đua tranh nhưng dùng hàm replace() của VBA thay cho hàm substitute() của Excel thì ngắn hơn 1 tẹo. Tốc độ thì không biết, thuật toán giữ nguyên của Ndu

Sub Replace_()
 Timer_ = Timer:                lRow = [a65432].End(xlUp).Row
 For Ww = 2 To lRow
    With Cells(Ww, 1)
        .Offset(, 1) = Len(.Value) - Len(Replace(.Value, "/", ""))
    End With
 Next Ww
 MsgBox Timer - Timer_    '.203125'
End Sub

 

[ndu96081631]

Thì ra hàm Replace trong VBA hoàn toàn khác với Replace của công thức. Nó có vẽ giống với SUBSTITUTE hơn!
Lở rồi, viết vầy luôn ha:

Function DemKT(Clls As Range, Kd As String) As Integer
   DemKT = Len(Clls) - Len(Replace(Clls, Kd, ""))
End Function

--------------------
Cãm ơn các anh chị

 

[ndu96081631]

Thừa thắng xong lên, tạo Function đếm nguyên 1 Range luôn:

Option Explicit
Function DemKT(Rng As Range, Kd As String) As Integer
   Dim K As Integer
   Dim Clls As Range
   For Each Clls In Rng
     K = K + Len(Clls) - Len(Replace(Clls, Kd, ""))
   Next
   DemKT = K
End Function

Và công thức:

=SUMPRODUCT(LEN(Rng)-LEN(SUBSTITUTE(Rng,"/",""))*1)

 

[danghung1980]

Function DemKT(Str As String, MinStr As String) As Integer
DemKT = (Len(Str) - Len(Replace(Str,MinStr, "")))/Len(MinStr)
End Function

 

[lochocmai]

xinn cám ơn , thật là hay và hưu4 ích quá!!!!!!!!!!!!!!!1

 

[khanhhien78]

Các cao thủ giúp em với!
em muốn đếm ký tự ! trong công thức ở Sheet2, ô A1: =Sheet1!A1 thì code VBA viết thế nào ah.