Giúp đỡ công thức đếm có lựa chọn !

[h5nry]

Chào các bạn,

Mình cần đếm số tháng khách hàng không mua hàng, nếu có >2 khoảng giữa việc mua và không mua thì lấy lần không mua lâu nhất.

Cám ơn sự giúp đỡ

 

[ndu96081631]

Lần sau nhớ post file xls nhé (vì không phải ai cũng xài Excel2007)
Tôi post lại đây

 

[h5nry]

Lần sau nhớ post file xls nhé (vì không phải ai cũng xài Excel2007)
Tôi post lại đây

YES Sir. Thank you very much

 

[salam]

Chào các bạn,

Mình cần đếm số tháng khách hàng không mua hàng, nếu có >2 khoảng giữa việc mua và không mua thì lấy lần không mua lâu nhất.

Cám ơn sự giúp đỡ

Bạn vào Đây để xem nhé.

 

[h5nry]

Bạn ơi, mình đọc bài đó rồi. Nhưng áp dụng vào yêu cầu của mình vẫn ko thành công. Bạn có thể giúp đỡ chi tiết hơn được ko?
Thanks

 

[Po_Pikachu]

Cách củ chuối! Đêm bằng tay vậy!

Function dem(cel As Range) Dim arr(1000) Dim temp(1000) For n = 1 To cel.Columns.Count + 1     If n = (cel.Columns.Count + 1) Then     temp(n) = 1     Else     temp(n) = cel.Cells(n)     End If Next k = 0 j = 1 For i = 1 To cel.Columns.Count + 1     If temp(i) = 1 Then         arr(j) = k         j = j + 1         k = 0     Else          k = k + 1     End If Next dem = Application.WorksheetFunction.Max(arr()) End Function

Bạn xem file nha! Thân.

 

[cheat]

Cách củ chuối! Đêm bằng tay vậy!

Function dem(cel As Range)
Dim arr(1000)
Dim temp(1000)
For n = 1 To cel.Columns.Count + 1
    If n = (cel.Columns.Count + 1) Then
    temp(n) = 1
    Else
    temp(n) = cel.Cells(n)
    End If
Next
k = 0
j = 1
For i = 1 To cel.Columns.Count + 1
    If temp(i) = 1 Then
        arr(j) = k
        j = j + 1
        k = 0
    Else
         k = k + 1
    End If
Next
dem = Application.WorksheetFunction.Max(arr())
End Function

Bạn xem file nha!
Thân.

sao loằng ngoằng thế nhỉ,
bạn cứ đếm sô bình thường
mỗi lần lưu lại số lần ->
khi gặp số 1 tiếp theo - dứng so sánh với max trước đó -> nếu lơn hơn thì gán max mới
cứ thế đến hết là OOK

 

[h5nry]

Cám ơn bạn Pikachu nhiều! Nhưng khó hiểu nhỉ! Vì mình chẳng biết macro ! Anyway thanks so much

 

[ndu96081631]

Đếm vầy nè, lẹ hơn!

Function Dem(Rng As Range) As Long
  Dim Clls As Range, k As Long
  For Each Clls In Rng
    Dem = ((Clls = 0) - Dem) * (Clls = 0)
  Next
End Function

 

[rollover79]

Xin góp 1 code

Function Dem(Rng As Range) As Long
    Dim i As Long
    Dim iRet As Long
    Dim iCurrentCount As Long
    For i = 1 To Rng.Columns.Count
        If Rng.Cells(1, i) = 0 Then
            iCurrentCount = iCurrentCount + 1
        Else
            If iCurrentCount > iRet Then iRet = iCurrentCount
            iCurrentCount = 0
        End If
    Next
    Dem = iRet
End Function

Đếm vầy nè, lẹ hơn!

Function Dem(Rng As Range) As Long
  Dim Clls As Range, k As Long
  For Each Clls In Rng
    Dem = ((Clls = 0) - Dem) * (Clls = 0)
  Next
End Function

Thế này chỉ đếm ra số ô có giá trị là 0 cuối cùng thôi, cuối cùng là ô có giá trị 1 thì trả về 0, hoặc trước đó có khoảng lớn hơn khoảng ở cuối thì nó vẫn trả về khoảng cuối.

 

[Po_Pikachu]

Phải công nhận rằng code em dài thật nhưng cũng dễ hiểu chứ có gì đâu!

Function Dem(Rng As Range) As Long Dim i As Long Dim iRet As Long Dim iCurrentCount As Long For i = 1 To Rng.Columns.Count If Rng.Cells(1, i) = 0 Then iCurrentCount = iCurrentCount + 1 Else If iCurrentCount > iRet Then iRet = iCurrentCount iCurrentCount = 0 End If Next Dem = iRet End Function [/code]

Code của ndu96081631 thì các số 0 ở cuối cùng lớn nhất thôi. Còn bạn thì lấy giá trị đếm số 0 cuối cùng trước 1 mà thôi! Còn nếu cuối cùng không có số 1 thì bạn đêm sai liền. Đây là bảng thông kê.

số liệu tượng trưng | Po_Pikachu | ndu96081631 | rollover79 101100000 | 5 | 5 |1 011001000 |3|3|2 011010001 |3|0|3 110000001 |6|0|6

Thân

 

[rollover79]

Cảm ơn Po_Pi, code của mình thiếu mất 1 dòng

If iCurrentCount > iRet Then iRet = iCurrentCount

ở trước lệnh gán

Dem = iRet

code đúng là

Function Dem(Rng As Range) As Long
    Dim i As Long
    Dim iRet As Long
    Dim iCurrentCount As Long
    For i = 1 To Rng.Columns.Count
        If Rng.Cells(1, i) = 0 Then
            iCurrentCount = iCurrentCount + 1
        Else
            If iCurrentCount > iRet Then iRet = iCurrentCount
            iCurrentCount = 0
        End If
    Next
    If iCurrentCount > iRet Then iRet = iCurrentCount
    Dem = iRet
End Function

Code của Po_Pi hơi dài và chưa tối ưu, cái con số 1000 cũng hơi bị hạn chế.

 

[ndu96081631]

Thế này chỉ đếm ra số ô có giá trị là 0 cuối cùng thôi, cuối cùng là ô có giá trị 1 thì trả về 0, hoặc trước đó có khoảng lớn hơn khoảng ở cuối thì nó vẫn trả về khoảng cuối.

Sorry! Thiếu 1 dòng, lý ra phải là:

Function Dem(Rng As Range) As Long
  Dim Clls As Range, k As Long
  For Each Clls In Rng
    k = ((Clls = 0) - k) * (Clls = 0)
    If k > Dem Then Dem = k
  Next
End Function

Hoặc "tà đạo"

Function Dem(Rng As Range) As Long
  Dim Clls As Range, k As Long
  For Each Clls In Rng
    k = ((Clls = 0) - k) * (Clls = 0)
    Dem = -k * (k > Dem) - Dem * (k <= Dem)
  Next
End Function

Gọn gàng chưa?