While n <= Len(Text)
    'Aktuelles Zeichen holen
    CharNow = Mid$(Text, n, 1)
 
    '2 gleiche Zeichen gefunden
    If CharNow = CharPrev Then
        'Gleiche Zeichen zählen
        CharCount = 0
        Do
            CharCount = CharCount + 1
            CharTmp = Mid$(Text, n + CharCount, 1)
        Loop Until CharTmp <> CharNow Or CharCount >= 254
        'Codiert notieren
        Text2 = Text2 & CharNow & Chr$(CharCount + 1)
        'gefundene Zeichen überspringen
        n = n + CharCount
    'Keine gleichen Zeichen
    Else
        Text2 = Text2 & CharNow
        CharPrev = CharNow
        n = n + 1
    End If
 
    DoEvents
Wend