Dim Arr As Variant
Dim Arr2 As Variant
Dim Lendiff As Integer
Dim Longer As String
 
Private Sub Form_Load()
    Check1.Caption = "Groß/Kleinschreibung beachten"
    Command1.Caption = "Vergleichen!"
    Text1.Text = ""
    Text2.Text = ""
End Sub
 
Private Sub Command1_Click()
    List1.Clear
    Lendiff = -1
    Call CheckLen(Text1.Text, Text2.Text)
End Sub
 
Private Function CheckLen(Text1 As String, Text2 As String)
    If Len(Text1) = Len(Text2) Then
        Call GetWords(Text1, Text2)
    ElseIf Len(Text1) > Len(Text2) Then
        Longer = "1. Text"
        Lendiff = Len(Text1) - Len(Text2)
        Text2 = Left(Text2, (Len(Text2) - Lendiff))
        Call GetWords(Text1, Text2)
    ElseIf Len(Text2) > Len(Text1) Then
        Longer = "2. Text"
        Lendiff = Len(Text2) - Len(Text1)
        Text1 = Left(Text1, (Len(Text1) - Lendiff))
        Call GetWords(Text1, Text2)
    End If
End Function
 
Private Function GetWords(Text1 As String, Text2 As String)
On Error Resume Next
    Dim i, b, Diff As Integer
 
    ReDim Arr(0 To (Len(Text1) - 1))
    For i = 1 To Len(Text1)
        Diff = 0
        b = i
        While Not b = 1
            Diff = Diff + 1
            b = b - 1
        Wend
        x = Mid$(Text1, i, i - Diff)
        Arr(i - 1) = x
    Next i
 
    ReDim Arr2(0 To (Len(Text2) - 1))
    For i = 1 To Len(Text2)
        Diff = 0
        b = i
        While Not b = 1
            Diff = Diff + 1
            b = b - 1
        Wend
        x = Mid$(Text2, i, i - Diff)
        Arr2(i - 1) = x
    Next i
 
    For i = 0 To UBound(Arr)
        Call RightChar(Arr(i), Arr2(i), i)
    Next i
 
    If List1.ListCount = 0 Then
        List1.AddItem "Keine Fehler. Beide Strings gleich!"
        If Lendiff <> -1 Then
            List1.AddItem "--------"
            List1.AddItem "ABER: der " & Longer & " ist um " & Lendiff & "" & _
              "Zeichen länger!!"
        End If
    Else
        If Lendiff <> -1 Then
            List1.AddItem "--------"
            List1.AddItem "Dazu ist der " & Longer & " um " & Lendiff & "" & _
              "Zeichen länger!!"
        End If
    End If
End Function
 
Private Function RightChar(Char1 As Variant, Char2 As Variant, Pos As Variant)
    If Check1.Value = 1 Then
        If Char1 <> Char2 Then
            List1.AddItem "An Stelle '" & (Pos + 1) & "' unterscheiden sich: " _
              & Char1 & " <> " & Char2
        End If
    Else
        If LCase(Char1) <> LCase(Char2) Then
            List1.AddItem "An Stelle '" & (Pos + 1) & "' unterscheiden sich: " _
              & Char1 & " <> " & Char2
        End If
    End If
End Function