Hallo,

ich habe noch einen Fehler entdeckt, wodurch ein falscher Schlüssel erstellt wurde.

Jetzt sollte es stimmen:

Option Explicit

Public Sub text_verschlüsseln()
    Debug.Print crypt("Testtext", "passwort", True)
End Sub

Private Function crypt(ByVal inp As String, ByVal pass As String, ByVal encrypt As Boolean) As String
    Dim Key(24) As String
    Dim i As Integer
    Dim tmp As String
    
    inp = LCase(inp)
    pass = LCase(pass)
    
    For i = 0 To 96
        inp = replace(inp, Chr(i), "")
        pass = replace(pass, Chr(i), "")
    Next i
    
    For i = 123 To 127
        inp = replace(inp, Chr(i), "")
        pass = replace(pass, Chr(i), "")
    Next i
    
    Call generate_key(Key(), pass)
    
    For i = 1 To Len(inp)
        tmp = tmp & get_character(Key, Mid(inp, i, 1), encrypt)
    Next i
        
    crypt = tmp
End Function

Private Sub generate_key(ByRef Key() As String, ByVal pass As String)
    Dim i As Integer, j As Integer
    Dim tmp As String, alphabet As String
    alphabet = "abcdefghijklmopqrstuvwxyz"
    
    pass = LCase(pass)
    tmp = pass
    
    For i = 1 To Len(tmp)
        If count_character(pass, Mid(tmp, i, 1)) > 1 Then
            pass = replace(pass, Mid(pass, i, 1), "")
        End If
    Next i
    
    For i = 1 To Len(pass)
        If InStr(1, alphabet, Mid(pass, i, 1), vbTextCompare) > 0 Then
            alphabet = replace(alphabet, Mid(pass, i, 1), "")
        End If
    Next i
    
    For i = 1 To Len(pass)
        Key(i - 1) = Mid(pass, i, 1)
    Next i
    
    j = Len(pass)
    
    For i = Len(alphabet) To 1 Step -1
        Key(j) = Mid(alphabet, i, 1)
        j = j + 1
    Next i
End Sub

Private Function get_character(ByRef Key() As String, ByVal char As String, ByVal encrypt As Boolean) As String
    Dim alphabet As String
    alphabet = "abcdefghijklmopqrstuvwxyz"
    
    If encrypt Then
        get_character = Key(InStr(1, alphabet, char, vbTextCompare) - 1)
    Else
        Dim alpha(24) As String
        Dim strKey As String
        Dim i As Integer
        
        For i = 0 To UBound(Key())
            strKey = strKey & Key(i)
        Next i
        
        For i = 1 To Len(alphabet)
            alpha(i - 1) = Mid(alphabet, i, 1)
        Next i
        
        get_character = alpha(InStr(1, strKey, char, vbTextCompare) - 1)
    End If
End Function

Private Function count_character(ByVal Text As String, ByVal char As String) As Integer
    Dim i As Integer, anzahl As Integer
    For i = 1 To Len(Text)
        If Mid(Text, i, 1) = char Then
            anzahl = anzahl + 1
        End If
    Next i
    
    count_character = anzahl
End Function

Gruß