đếm số lần xuất hiện dữ liệu liên tiếp

[sep_hatxel]

Mình có file excel mong GPE giúp đỡ!
- Dữ liệu ở sheet1: Mình cần đếm số lần xuất hiện các ô có dữ liệu liên tiếp, kết quả xuất sang sheet2. Ví dụ minh hoạ:
- Dòng A: số lần xuất hiện 1 ô có dữ liệu là 4, số lần xuất hiện có 2 ô dữ liệu liên tiếp là 0, số lần xuất hiện có 3 ô dữ liệu liên tiếp là 1, số lần xuất hiện có 4 ô dữ liệu liên tiếp là 2, số lần xuất hiện có 5 ô dữ liệu liên tiếp là 1.
- Tương tự như vậy đếm ở dòng B
=> Kết quả xuất sang sheet2.
- Rất mong GPE giúp đỡ. Xin chân thành cảm ơn!

 

[Ba Tê]

Mình có file excel mong GPE giúp đỡ!
- Dữ liệu ở sheet1: Mình cần đếm số lần xuất hiện các ô có dữ liệu liên tiếp, kết quả xuất sang sheet2. Ví dụ minh hoạ:
- Dòng A: số lần xuất hiện 1 ô có dữ liệu là 4, số lần xuất hiện có 2 ô dữ liệu liên tiếp là 0, số lần xuất hiện có 3 ô dữ liệu liên tiếp là 1, số lần xuất hiện có 4 ô dữ liệu liên tiếp là 2, số lần xuất hiện có 5 ô dữ liệu liên tiếp là 1.
- Tương tự như vậy đếm ở dòng B
=> Kết quả xuất sang sheet2.
- Rất mong GPE giúp đỡ. Xin chân thành cảm ơn!

Cho chạy thử Sub này xem sao.

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, N As Long, C As Long
With Sheet1
    C = .Range("A5").SpecialCells(xlLastCell).Column
    sArr = .Range("A5", .Range("A5").End(xlDown)).Resize(, C).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To C)
End With
For I = 1 To UBound(sArr, 1)
    N = 0
    For J = 2 To C
        If sArr(I, J) <> Empty Then N = N + 1
        If sArr(I, J) = Empty Or J = C Then
            If N > 0 Then
                dArr(I, N) = dArr(I, N) + 1
                N = 0
            End If
        End If
    Next J
Next I
Sheet2.Range("D5").Resize(I - 1, C) = dArr
End Sub

 

[sep_hatxel]

Cho chạy thử Sub này xem sao.

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, N As Long, C As Long
With Sheet1
    C = .Range("A5").SpecialCells(xlLastCell).Column
    sArr = .Range("A5", .Range("A5").End(xlDown)).Resize(, C).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To C)
End With
For I = 1 To UBound(sArr, 1)
    N = 0
    For J = 2 To C
        If sArr(I, J) <> Empty Then N = N + 1
        If sArr(I, J) = Empty Or J = C Then
            If N > 0 Then
                dArr(I, N) = dArr(I, N) + 1
                N = 0
            End If
        End If
    Next J
Next I
Sheet2.Range("D5").Resize(I - 1, C) = dArr
End Sub

Vâng, cảm ơn Bác rất nhiều ạ!