Tìm số ngày nghỉ liền nhau 2 ngày trở lên

nvh611 · 28/1/19

Nhờ các bạn trên diễn đàn giúp đỡ như file đính kèm
Cảm ơn các bạn

HieuCD · 28/1/19

nvh611 đã viết:
Nhờ các bạn trên diễn đàn giúp đỡ như file đính kèm
Cảm ơn các bạn

Theo cách tính của các cột phụ
=COUNTIFS(C5:F26,"X",C6:F27,"X")

snow25 · 28/1/19

nvh611 đã viết:
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é.

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)

nvh611 · 28/1/19

HieuCD đã viết:
Theo cách tính của các cột phụ
=COUNTIFS(C5:F26,"X",C6:F27,"X")

Cảm ơn bạn @HieuCD bạn sử dụng công thức hay quá.

Bài đã được tự động gộp: 28/1/19

snow25 đã viết:

Dù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)

Cảm ơn bạn @snow25 hàm rất đúng trong trường hợp này
Bây giờ mình muốn tìm số ngày liên tiếp =3 hoặc bất kỳ bằng 4,5...... thì thay đổi hàm chỗ nào được nhỉ

snow25 · 28/1/19

nvh611 đã viết:
Cảm ơn bạn @HieuCD bạn sử dụng công thức hay quá.

Bài đã được tự động gộp: 28/1/19

Cảm ơn bạn @snow25 hàm rất đúng trong trường hợp này
Bây giờ mình muốn tìm số ngày liên tiếp =3 hoặc bất kỳ bằng 4,5...... thì thay đổi hàm chỗ nào được nhỉ

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)

nvh611 · 28/1/19

snow25 đã viết:

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)

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

tam888 · 28/1/19

nvh611 đã viết:
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é.

Tạ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)

snow25 · 28/1/19

nvh611 đã viết:
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é.

Theo mình thấy 4 có trường hợp nào đâu nhỉ.

HieuCD · 28/1/19

tam888 đã viết:

Tạ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)

Bỏ bớt 1 vòng For theo dòng được không bạn, tốc độ tăng lên nhiều

tam888 · 28/1/19

HieuCD đã viết:
Bỏ bớt 1 vòng For theo dòng được không bạn, tốc độ tăng lên nhiều

có đâ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

HieuCD · 28/1/19

tam888 đã viết:

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

Hay 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

nvh611 · 28/1/19

tam888 đã viết:

có đâ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

cẢM ƠN BẠN @tam888 CÔNG THỨC ĐÃ ĐÚNG

tam888 · 28/1/19

HieuCD đã viết:
Hay 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

Thôi, có mỗi hàm nhỏ, rút nữa cũng chắc chẳng được lợi bao nhiêu

Bài đã được tự động gộp: 28/1/19

Tôi thì quan tâm tính hiệu quả về thời gian, còn độ ngắn dòng lệnh thì ít để ý
Bài này có thể nhanh hơn chút nếu dùng Do While, ai đó thử sức xem sao. Tuy thế với số lượng dữ liệu ít thì hiệu quả này là không đáng kể

Phuocam · 28/1/19

Cho 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

HieuCD · 28/1/19

phuocam đã viết:

Cho 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

Quá tuyệt vời

Chúc các bạn buổi tối vui

nvh611 · 28/1/19

tam888 đã viết:

có đâ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

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ất
Cảm ơn các bạn bạn

Phuocam · 28/1/19

nvh611 đã viết:
tìm số ngày nghỉ liên tiếp lớn nhất

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

nvh611 · 28/1/19

phuocam đã viết:

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

Cảm ơn bạn @phuocam liệu 2 hàm này ghép với nhau được không bạn?

tam888 · 28/1/19

nvh611 đã viết:
Cảm ơn bạn @phuocam liệu 2 hàm này ghép với nhau được không bạn?

Lạ nhỉ, 1 cái tìm số lượng, 1 cái tìm max sao lại ghép vào nhau?

snow25 · 28/1/19

nvh611 đã viết:
Cảm ơn bạn @phuocam liệu 2 hàm này ghép với nhau được không bạn?

Được chứ.

Tìm số ngày nghỉ liền nhau 2 ngày trở lên

Thành viên thường trực

File đính kèm

Chuyên gia GPE

Thành viên gạo cội

File đính kèm

Thành viên thường trực

Thành viên gạo cội

Thành viên thường trực

Thành viên tích cực

Thành viên gạo cội

Chuyên gia GPE

Thành viên tích cực

Chuyên gia GPE

Thành viên thường trực

Thành viên tích cực

Thành viên mới

Chuyên gia GPE

Thành viên thường trực

Thành viên mới

Thành viên thường trực

Thành viên tích cực

Thành viên gạo cội

Facebook

Group