[bax]

da kommt echt keine 4... zumindest bis zur 40. Zeile

allerdings war ich zu faul, das mit Zettel und Stift herauszufinden, dafür gibt es ja excel

Sub Lustige_Zahlenreihe()

ZEILE = 1

Worksheets("Tabelle1").Cells(ZEILE, 1).NumberFormat = "@"
Worksheets("Tabelle1").Cells(ZEILE, 2).NumberFormat = "@"
Worksheets("Tabelle1").Cells(ZEILE, 3).NumberFormat = "@"
Worksheets("Tabelle1").Cells(ZEILE, 1) = "1"
Worksheets("Tabelle1").Cells(ZEILE, 2) = "1"
Worksheets("Tabelle1").Cells(ZEILE, 3) = "1"

EINSPRUNG:

NEUES_ZEICHEN = ""

WERT = Worksheets("Tabelle1").Cells(ZEILE, 3)

STELLE = 1

STELLE_BEGINN = STELLE

ZEICHEN = Mid$(WERT, STELLE_BEGINN, 1)

STELLE = STELLE + 1

NAECHSTES:

If STELLE > Len(WERT) Then

    NEUES_ZEICHEN = NEUES_ZEICHEN + Format(STELLE - STELLE_BEGINN) + Format(ZEICHEN)

    GoTo FERTIG

End If

If Mid$(WERT, STELLE, 1) = ZEICHEN Then

    STELLE = STELLE + 1

    GoTo NAECHSTES

Else

    NEUES_ZEICHEN = NEUES_ZEICHEN + Format(STELLE - STELLE_BEGINN) + Format(ZEICHEN)

    STELLE_BEGINN = STELLE

    ZEICHEN = Mid$(WERT, STELLE_BEGINN, 1)
    
End If

GoTo NAECHSTES

FERTIG:

ZEILE = ZEILE + 1

Worksheets("Tabelle1").Cells(ZEILE, 1).Select
Worksheets("Tabelle1").Cells(ZEILE, 1).NumberFormat = "@"
Worksheets("Tabelle1").Cells(ZEILE, 2).NumberFormat = "@"
Worksheets("Tabelle1").Cells(ZEILE, 3).NumberFormat = "@"

Worksheets("Tabelle1").Cells(ZEILE, 1) = Format(ZEILE)
Worksheets("Tabelle1").Cells(ZEILE, 2) = Format(Len(NEUES_ZEICHEN))
Worksheets("Tabelle1").Cells(ZEILE, 3) = NEUES_ZEICHEN

A = MsgBox("WEITER?", vbOKCancel)

If A = xlYes Then GoTo EINSPRUNG

End Sub

greetz Rajko