Countfunktion

Es handelt sich hierbei um 2 unterschiedliche Blöcke. Immer vom ersten _1 bis zum letzten _4 ist ein Block. Mein Zählmakro müsste aufgrund oberer Datenreihe folgendes ermitteln:
Block 1 (Anzahl Elemente) : 8
Block 2 (Anzahl Elemente) : 5

Sowohl Makro A:
Option Explicit
Option Base 1
Public Sub zaehlen()
Dim Zeile As Long, Feld() As Integer, Anzahl As Integer, zaehler As Integer
For Zeile = 1 To Range("A65536").End(xlUp).Row
If Mid(Cells(Zeile, 1).Value, 5) = 4 And Mid(Cells(Zeile + 1, 1).Value, 5) _
= 1 Or Zeile = Range("A65536").End(xlUp).Row Then
If Anzahl <> 0 Then
zaehler = zaehler + 1
ReDim Preserve Feld(zaehler)
Feld(zaehler) = Anzahl + 1
Anzahl = 0
Else
Anzahl = Anzahl + 1
End If
Else
Anzahl = Anzahl + 1
End If
Next
For Zeile = 1 To zaehler
Cells(Zeile, 2).Value = "Block " & CStr(Zeile) & " - " & CStr(Feld(Zeile)) & " Einträge"
Next
End Sub

Als auch Makro B:

Option Explicit
Sub Zaehlfunktion()
Dim lgRow As Long
Dim lgZiel As Long
Dim wks As Worksheet
Dim iCount As Integer

Set wks = Worksheets("Tabelle2")
lgRow = 1
lgZiel = 1
iCount = 1

Do
If Left(Cells(lgRow, 1), 5) <> Left(Cells(lgRow + 1, 1), 5) Then
wks.Cells(lgZiel, 1) = Left(Cells(lgRow, 1), 4)
wks.Cells(lgZiel, 2) = iCount
lgZiel = lgZiel + 1
iCount = 0
End If

iCount = iCount + 1
lgRow = lgRow + 1

Loop Until IsEmpty(Cells(lgRow, 1))

End Sub

Ermitteln als Lösung aber, dass es sich um nur einen Block mit 13 Elementen handeln würde.
Ich denke, man muss hier nur etwas geringfügig verändern. Weiß jemand Rat ???

Gruß aus Tü
Dari