Hàm Countif bằng VBA
- Thread starter nvh611
- Ngày gửi
snow25
Thành viên gạo cội
- Tham gia
- 24/7/18
- Bài viết
- 3,492
- Được thích
- 3,518
- Donate (Momo)
- Giới tính
- Nam
Bạn xem.
Mã:
Function dem(ByVal dk As String, ByVal dk1 As String, Optional phancach As String = ";") As Long
Dim a As Long, T, i As Long
T = Split(phancach & dk1, phancach)
For i = 1 To UBound(T)
If UCase(dk) = UCase(T(i)) Then
a = a + 1
End If
Next i
dem = a
End Function
Mã:
=dem(J11,$H$4)
Upvote
0
Chuẩn hay không thì do bạn phán quyết. Nhưng ngắn gọn thì với công việc ấy, nó không phải là ngắn gọn.
Upvote
0
snow25
Thành viên gạo cội
- Tham gia
- 24/7/18
- Bài viết
- 3,492
- Được thích
- 3,518
- Donate (Momo)
- Giới tính
- Nam
Bạn xem code nhé.
Mã:
Function dem(ByVal dk As String, ParamArray mang()) As Long
Dim a As Long, T, i As Long, arr, n As Integer, j As Long
For n = LBound(mang) To UBound(mang)
arr = laymang(mang(n))
For i = 1 To UBound(arr, 1)
For j = 1 To UBound(arr, 2)
T = Split(";" & arr(i, j), ";")
For k = 1 To UBound(T)
If UCase(dk) = UCase(T(k)) Then
a = a + 1
End If
Next k
Next j
Next i
Next n
dem = a
End Function
Function laymang(ByVal arr As Range)
Dim arr1()
If arr.Count = 1 Then
ReDim arr1(1 To 1, 1 To 1): arr1(1, 1) = arr.Value
Else
arr1 = arr.Value
End If
laymang = arr1()
End Function
Mã:
=dem(J11,H4,K6)
Upvote
0
Không hiểu thì đem giáo chỉ vào đâu đây?
Làm ngược rồi. Viết sao cho code mảng gọi code đếm chứ.
Function DemTrongO(ByVal s As String, ByVal dk As String) As Integer
Dim v
dk = UCase(dk) ' nếu đặt bên trong vòng lặp như code trên thì con toán này bị lặp lại nhiều lần
For Each v In Split(UCase(s), ";") ' ta chỉ cần đọc phần tử (không sửa đổi) cho nên không cần phải gán nó ra mảng
If v = dk Then DemTrongO = DemTrongO + 1 ' số đếm đơn giản cho nên khong cần biến trung gian
Next v
End Function
Function dem(ByVal dk As String, ParamArray mang()) As Long
...
For each O in mangGiDo
dem = dem + DemTrongO(O)
Next O
...
Upvote
0
snow25
Thành viên gạo cội
- Tham gia
- 24/7/18
- Bài viết
- 3,492
- Được thích
- 3,518
- Donate (Momo)
- Giới tính
- Nam
Bác xem cháu sửa thế này có được không ạ.
Mã:
Function dem(ByVal dk As String, ParamArray mang()) As Long
Dim arr, n As Integer, s, s1
For n = LBound(mang) To UBound(mang)
arr = laymang(mang(n))
For Each s In arr
For Each s1 In Split(s, ";")
If UCase(dk) = UCase(s1) Then
dem = dem + 1
End If
Next
Next
Next n
End Function
Function laymang(ByVal arr As Range)
Dim arr1()
If arr.Count = 1 Then
ReDim arr1(1 To 1, 1 To 1): arr1(1, 1) = arr.Value
Else
arr1 = arr.Value
End If
laymang = arr1()
End Function
Mã:
=dem(J11,H4,K6,K6:K7)
Upvote
0
Có thấy sửa gì đâu mà bảo được hay không.
For n = LBound(mang) To UBound(mang) ' n lượt
arr = laymang(mang(n))
For Each s In arr ' m lượt
For Each s1 In Split(s, ";") ' k lượt
If UCase(dk) = UCase(s1) Then
'.. trị dk được UCase tất cả là n*m*k lượt
dem = dem + 1
End If
Next
Next
Next n
Upvote
0
Xem code
Mã:
Function CountIfArrS(ByVal Dk As String, ParamArray ArrS()) As Long
Dim Arr, iTem, S, iStr
Dim k As Long
Dk = UCase(Dk)
For Each Arr In ArrS
For Each iTem In Arr
S = Split(UCase(iTem), ";")
For Each iStr In S
If iStr = Dk Then k = k + 1
Next iStr
Next iTem
Next Arr
CountIfArrS = k
End Function
Lần chỉnh sửa cuối:
Upvote
0
Mã:
Function CountIfArrS(ByVal Dk As String, ParamArray ArrS()) As Long
Dim Arr, iTem, S, iStr
Dim i As Long, k As Long
Dk = UCase(Dk)
For Each Arr In ArrS
For Each iTem In Arr
S = Split(UCase(Replace(Replace(Replace(iTem, ",", ";"), "-", ";"), ":", ";")), ";")
For Each iStr In S
If iStr = Dk Then k = k + 1
Next iStr
Next iTem
Next Arr
CountIfArrS = k
End Function
Upvote
0
Trời! Cảm ơn bạn rất nhiều
Khó khăn phức tạp đến đâu bạn cũng làm được
Cảm ơn bạn:
Chúc bạn cuối tuần vui vẻ!
Upvote
0
Mã:
Function CountIfArrS(ByVal Dk As String, ParamArray ArrS()) As Long
Dim Arr, iTem, n As Long, k As Long
n = Len(Dk)
Dk = UCase(Dk)
For Each Arr In ArrS
For Each iTem In Arr
k = k + (Len(iTem) - Len(Replace(UCase(iTem), Dk, "", 1))) / n
Next iTem
Next Arr
CountIfArrS = k
End Function
Upvote
0
Rất cảm ơn bạn
Chúc bạn luôn vui.
Upvote
0
