Xin giúp hàm đếm đoạn có điều kiện

[bluecat]

Public Function DemDoanNoLienTuc(MyRng As Range, chieudai_lientuc As Long, DK2 As String, Hang_Cot As Long, chieudai_nolientuc As Long) As Long
' dung dem trng 1 rng co bao nhieu chieudai_nolientuc
'chieudai_nolientuc o day la do dai toi thieu cua 1 doan khong xh cac so lien tiep co DK, co the tu do chon lua chieudai_nolientuc
 
   Dim i As Long, BD As Long, gioihan As Long, solan As Long
   Dim hang As Long, cot As Long, dem As Long
Select Case Hang_Cot
   Case 1: If MyRng.Columns.Count <> 1 Then Exit Function
   gioihan = MyRng.Rows.Count
   hang = chieudai_lientuc
    cot = 1
   Case 2: If MyRng.Rows.Count <> 1 Then Exit Function
   gioihan = MyRng.Columns.Count
   cot = chieudai_lientuc
   hang = 1
End Select
    For i = 1 To gioihan '- (chieudai_lientuc - 1)
    dem = Application.WorksheetFunction.CountIf(MyRng(i).Resize(hang, cot), DK2)
        If dem > 0 Then
            BD = BD + 1
               If BD > chieudai_nolientuc - 1 Then
               solan = solan + 1
               DemDoanNoLienTuc = solan
               BD = 0
               End If
        ElseIf dem = 0 Then
        i = i + chieudai_lientuc - 1
        BD = 0
        End If
    If BD > chieudai_nolientuc - 1 Then DemDoanNoLienTuc = solan + 1
       ' MsgBox "i = " & i & Chr(10) & "dem = " & dem & Chr(10) & "BD = " & BD & "(> 4)" & Chr(10) & "DemDoan = " & solan
    Next
 
End Function

Xin GPE giúp tôi viết lại hàm trên cho đúng hoặc chỉ cho tôi một giải thuật khác.

 

[bluecat]

Sao không ai giúp tui hết vậy kà???
Chẳng lẽ bài này dễ wé? Ai thấy link ở đâu giống vậy chỉ tui cũng được.THX

 

[bluecat]

Với bài tóan trên của bạn tôi có cách giải tạm thời như sau :
- tạo 1 mảng lưu giá trị range cần đếm
- thay thế các số liên tiếp chưa đủ điều kiện của chieudai_lientuc bằng ký tự "-"
- sau đó dùng thuật toán tương tự như trên để đếm các ký tự "-" và so sánh với điều kiện chieudai_nolientuc
- cuối cùng trả về rng cần đếm mảng đã lưu ban đầu.

 

[bluecat]

- Nếu tô màu đỏ cho các số liên tục đủ diều kiện của chieudai_lientuc
- Đếm các ô màu trắng , bài toán được giải quyết xong
Nhưng mỗi lần sort để tìm KQ tối ưu thì hơi bị bất tiện, nó tô màu lại hoài(do trong sort có chứa công thức).
Tôi đã thử dùng mảng để xử lý như bạn nói nhưng bị kẹt ở lỗi Type Mismatch

Sub Test()
Dim i As Long, DK As String, dkiendem As Long
Dim mangGoc(20)
mangGoc(20) = Range("A2:U2").Value
dkiendem = 3
DK = "-"
For i = 0 To 20
If mangGoc(i) <> DK Then
mangGoc(i) = "-"
End If
Next
Range("A23:U23").Value = mangGoc(20)
End Sub

đã khai báo mangGoc() as variant, string nhưng chẳng ăn thua. BÍ!!!