Option Explicit

Public Function countOneSequenzesInBinary(binarychain As String) As Integer
    Dim cntOneSequences As Integer  'Counter for One-Sequences
    Dim lastCharacter As String     'Memorizer for kind of Character at last round
    Dim cntCharacters As Integer    'Counter for stringiterating
    
    'Iterate about the binarychain
    'Increment counter if characters change from '0' to '1'
    lastCharacter = "0"
    cntCharacters = 1
    Do While cntCharacters <= Len(binarychain)
        If (lastCharacter = "0" And Left(Right(binarychain, Len(binarychain) - cntCharacters + 1), 1) = "1") Then
            cntOneSequences = cntOneSequences + 1
        End If
        lastCharacter = Left(Right(binarychain, Len(binarychain) - cntCharacters + 1), 1)
        cntCharacters = cntCharacters + 1
    Loop
    countOneSequenzesInBinary = cntOneSequences
End Function

Public Function countOnesInBinary(binarychain As String) As Integer
    Dim longestOnesChain As Integer 'Memorizer for longest 1-chain
    Dim lastCharacter As String     'Memorizer for kind of Character at last round
    Dim cntCharacters As Integer    'Counter for stringiterating
    Dim cntActualChain As Integer   'Counter for actual 1-chain
    
    'Iterate about the binarychain
    'Restart 1-counter if characters change from '0' to '1'
    'Increment 1-counter if last character was '1' and actual character is also '1'
    lastCharacter = "0"
    cntCharacters = 1
    Do While cntCharacters <= Len(binarychain)
        If (lastCharacter = "0" And Left(Right(binarychain, Len(binarychain) - cntCharacters + 1), 1) = "1") Then
            cntActualChain = 1
        End If
        If (lastCharacter = "1" And Left(Right(binarychain, Len(binarychain) - cntCharacters + 1), 1) = "1") Then
            cntActualChain = cntActualChain + 1
        End If
        If (cntCharacters = Len(binarychain) And Left(Right(binarychain, Len(binarychain) - cntCharacters + 1), 1) = "1") Then
            If longestOnesChain < cntActualChain Then longestOnesChain = cntActualChain
        End If
        If (lastCharacter = "1" And Left(Right(binarychain, Len(binarychain) - cntCharacters + 1), 1) = "0") Then
            If longestOnesChain < cntActualChain Then longestOnesChain = cntActualChain
        End If
        
        lastCharacter = Left(Right(binarychain, Len(binarychain) - cntCharacters + 1), 1)
        cntCharacters = cntCharacters + 1
    Loop
    
    countOnesInBinary = longestOnesChain
End Function

Public Sub testCountSequences()
    Dim testSequence As String
    Dim sequences As Integer
    Dim sequenceLen As Integer
    
    testSequence = "0011000001111000111111111"
    sequences = countOneSequenzesInBinary(testSequence)
    sequenceLen = countOnesInBinary(testSequence)
    
    MsgBox ("Testsequenz: " & testSequence & vbNewLine & vbNewLine & "Anzahl 1er-Sequenzen: " & sequences & vbNewLine & "Länge der längsten 1er-Kette: " & sequenceLen)
    
End Sub