Theo cách tính của các cột phụNhờ các bạn trên diễn đàn giúp đỡ như file đính kèm
Cảm ơn các bạn
Dùng hàm tự tạo nhé.Nhờ các bạn trên diễn đàn giúp đỡ như file đính kèm
Cảm ơn các bạn
Function solan(ByVal mang As Range) As Integer
Dim arr, i As Long, j As Integer, tong As Integer, a As Integer
arr = mang.Value
For j = 1 To UBound(arr, 2)
a = 0
For i = 1 To UBound(arr, 1) - 1
If UCase(arr(i, j)) = "X" And UCase(arr(i + 1, j)) = "X" Then
a = a + 1
Else
tong = tong + a
a = 0
End If
Next i
tong = tong + a
Next j
solan = tong
End Function
=solan(C5:F27)
Cảm ơn bạn @HieuCD bạn sử dụng công thức hay quá.Theo cách tính của các cột phụ
=COUNTIFS(C5:F26,"X",C6:F27,"X")
Cảm ơn bạn @snow25 hàm rất đúng trong trường hợp nàyDùng hàm tự tạo nhé.
Mã:Function solan(ByVal mang As Range) As Integer Dim arr, i As Long, j As Integer, tong As Integer, a As Integer arr = mang.Value For j = 1 To UBound(arr, 2) a = 0 For i = 1 To UBound(arr, 1) - 1 If UCase(arr(i, j)) = "X" And UCase(arr(i + 1, j)) = "X" Then a = a + 1 Else tong = tong + a a = 0 End If Next i tong = tong + a Next j solan = tong End Function
Mã:=solan(C5:F27)
Vậy bạn dùng cái này xem.Thích số mấy thì điền vào.
Function solan(ByVal mang As Range, Optional ByVal so As Integer = 1) As Integer
Dim arr, i As Long, j As Integer, tong As Integer, a As Integer
arr = mang.Value
For j = 1 To UBound(arr, 2)
a = 0
For i = 1 To UBound(arr, 1) - 1
If UCase(arr(i, j)) = "X" And UCase(arr(i + 1, j)) = "X" Then
a = a + 1
Else
If a >= so Then tong = tong + a
a = 0
End If
Next i
If a >= so Then tong = tong + a
Next j
solan = tong
End Function
=solan(C5:F27,3)
Cảm ơn bạn, nhanh quáVậy bạn dùng cái này xem.Thích số mấy thì điền vào.
Mã:Function solan(ByVal mang As Range, Optional ByVal so As Integer = 1) As Integer Dim arr, i As Long, j As Integer, tong As Integer, a As Integer arr = mang.Value For j = 1 To UBound(arr, 2) a = 0 For i = 1 To UBound(arr, 1) - 1 If UCase(arr(i, j)) = "X" And UCase(arr(i + 1, j)) = "X" Then a = a + 1 Else If a >= so Then tong = tong + a a = 0 End If Next i If a >= so Then tong = tong + a Next j solan = tong End Function
Mã:=solan(C5:F27,3)
Tạm sửa lại thế nàyCảm ơn bạn, nhanh quá
Vẫn bị sai bạn à
Nếu trường hợp =3 thì đúng
Khi mình thay =4 thì kết quả =0
Bạn chỉnh giúp mình với nhé.
Function SolanX(ByVal mang As Range, Optional ByVal So As Long = 2) As Integer
Dim arr, i As Long, j As Long, a As Long, n As Long, k As Long, Tim As Boolean
arr = mang.Value
a = 0
n = UBound(arr, 1) - So + 1
For j = 1 To UBound(arr, 2)
For i = 1 To n
Tim = True
For k = i To i + So - 1
If Not UCase(arr(k, j)) = "X" Then Tim = False: Exit For
Next
If Tim Then a = a + 1
Next i
Next j
SolanX = a
End Function
Theo mình thấy 4 có trường hợp nào đâu nhỉ.Cảm ơn bạn, nhanh quá
Vẫn bị sai bạn à
Nếu trường hợp =3 thì đúng
Khi mình thay =4 thì kết quả =0
Bạn chỉnh giúp mình với nhé.
Bỏ bớt 1 vòng For theo dòng được không bạn, tốc độ tăng lên nhiềuTạm sửa lại thế này
Mã:Function SolanX(ByVal mang As Range, Optional ByVal So As Long = 2) As Integer Dim arr, i As Long, j As Long, a As Long, n As Long, k As Long, Tim As Boolean arr = mang.Value a = 0 n = UBound(arr, 1) - So + 1 For j = 1 To UBound(arr, 2) For i = 1 To n Tim = True For k = i To i + So - 1 If Not UCase(arr(k, j)) = "X" Then Tim = False: Exit For Next If Tim Then a = a + 1 Next i Next j SolanX = a End Function
Công thức (ví dụ)
=SolanX(C5:F27,4)
có đây, cũng vừa nghĩ nên bỏ bớtBỏ bớt 1 vòng For theo dòng được không bạn, tốc độ tăng lên nhiều![]()
Function solan(ByVal mang As Range, Optional ByVal So As Long= 2) As Integer
Dim arr, i As Long, j As Long, tong As Long, a As Long, n As Long
arr = mang.Value
tong = 0
n=UBound(arr, 1)
For j = 1 To UBound(arr, 2)
a = 0
For i = 1 To n
If UCase(arr(i, j)) = "X" Then
a = a + 1
Else
If a >= So Then tong = tong + a - So + 1
a = 0
End If
Next i
If a >= So Then tong = tong + a - So + 1
Next j
solan = tong
End Function
Hay quácó đây, cũng vừa nghĩ nên bỏ bớt
Mã:Function solan(ByVal mang As Range, Optional ByVal So As Integer = 2) As Integer Dim arr, i As Long, j As Long, tong As Long, a As Integer, n As Long arr = mang.Value tong = 0 n=UBound(arr, 1) For j = 1 To UBound(arr, 2) a = 0 For i = 1 To n If UCase(arr(i, j)) = "X" Then a = a + 1 Else If a >= So Then tong = tong + a - So + 1 a = 0 End If Next i If a >= So Then tong = tong + a - So + 1 Next j solan = tong End Function
cẢM ƠN BẠN @tam888 CÔNG THỨC ĐÃ ĐÚNGcó đây, cũng vừa nghĩ nên bỏ bớt
Mã:Function solan(ByVal mang As Range, Optional ByVal So As Long= 2) As Integer Dim arr, i As Long, j As Long, tong As Long, a As Long, n As Long arr = mang.Value tong = 0 n=UBound(arr, 1) For j = 1 To UBound(arr, 2) a = 0 For i = 1 To n If UCase(arr(i, j)) = "X" Then a = a + 1 Else If a >= So Then tong = tong + a - So + 1 a = 0 End If Next i If a >= So Then tong = tong + a - So + 1 Next j solan = tong End Function
Thôi, có mỗi hàm nhỏ, rút nữa cũng chắc chẳng được lợi bao nhiêuHay quá, code chạy rất nhanh, nếu rút ngắn thêm vài dòng lệnh là tuyệt vời
![]()
Function solan(ByVal mang As Range, Optional ByVal So As Long = 2) As Integer
Dim arr, i As Long, j As Long, a As Long, n As Long
arr = mang.Value
n = UBound(arr, 1)
For j = 1 To UBound(arr, 2)
a = 0
For i = 1 To n
If UCase(arr(i, j)) = "X" Then
a = a + 1
If a >= So Then solan = solan + 1
Else
a = 0
End If
Next i
Next j
End Function
Quá tuyệt vờiCho em ké với:
Mã:Function solan(ByVal mang As Range, Optional ByVal So As Long = 2) As Integer Dim arr, i As Long, j As Long, a As Long, n As Long arr = mang.Value n = UBound(arr, 1) For j = 1 To UBound(arr, 2) a = 0 For i = 1 To n If UCase(arr(i, j)) = "X" Then a = a + 1 If a >= So Then solan = solan + 1 Else a = 0 End If Next i Next j End Function
Phiền bạn @tam888 và bạn @HieuCD cho thêm dòng tìm số ngày nghỉ liên tiếp lớn nhấtcó đây, cũng vừa nghĩ nên bỏ bớt
Mã:Function solan(ByVal mang As Range, Optional ByVal So As Long= 2) As Integer Dim arr, i As Long, j As Long, tong As Long, a As Long, n As Long arr = mang.Value tong = 0 n=UBound(arr, 1) For j = 1 To UBound(arr, 2) a = 0 For i = 1 To n If UCase(arr(i, j)) = "X" Then a = a + 1 Else If a >= So Then tong = tong + a - So + 1 a = 0 End If Next i If a >= So Then tong = tong + a - So + 1 Next j solan = tong End Function
tìm số ngày nghỉ liên tiếp lớn nhất
Function MaxX(ByVal mang As Range) As Integer
Dim arr, i As Long, j As Long, a As Long, n As Long
arr = mang.Value
n = UBound(arr, 1)
For j = 1 To UBound(arr, 2)
a = 0
For i = 1 To n
If UCase(arr(i, j)) = "X" Then
a = a + 1
If a > MaxX Then MaxX = a
Else
a = 0
End If
Next i
Next j
End Function
Cảm ơn bạn @phuocam liệu 2 hàm này ghép với nhau được không bạn?Mã:Function MaxX(ByVal mang As Range) As Integer Dim arr, i As Long, j As Long, a As Long, n As Long arr = mang.Value n = UBound(arr, 1) For j = 1 To UBound(arr, 2) a = 0 For i = 1 To n If UCase(arr(i, j)) = "X" Then a = a + 1 If a > MaxX Then MaxX = a Else a = 0 End If Next i Next j End Function
Lạ nhỉ, 1 cái tìm số lượng, 1 cái tìm max sao lại ghép vào nhau?Cảm ơn bạn @phuocam liệu 2 hàm này ghép với nhau được không bạn?