Зашифровать слово из ячейки Excel обобщенным шифром подстановки

Option Explicit
 
 
 
Sub Main()
    MsgBox GetNewAllabet(777) '777 - это число взято с потолка, является ключом к генерированию определенной последовательности
End Sub
 
Private Function GetNewAllabet(key As Integer)
    Dim i As Integer, ArrAlfaBet() As String
    Const AlfaBet As String = "абвгдеёжзийклмнопрстуфхцчшщъыьэюяАБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ" & _
                          "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" & _
                          "1234567890.,<>:;!@#$%^&*()_+-=?/\}{][|' "
    ReDim ArrAlfaBet(1 To Len(AlfaBet))
    For i = 1 To Len(AlfaBet)
        ArrAlfaBet(i) = Mid(AlfaBet, i, 1)
    Next i
    Unsort ArrAlfaBet, key
    GetNewAllabet = Join(ArrAlfaBet, "")
End Function
'Процедура перемешивания массива случайным образом
Private Sub Unsort(list() As String, key As Integer)
Dim i As Long
Dim pos As Long, min As Long
Dim tmp As String, max As Long
Rnd (-key)
min = LBound(list): max = UBound(list)
    For i = min To max - 1
        pos = Int((max - i + 1) * Rnd + i)
        tmp = list(pos)
        list(pos) = list(i)
        list(i) = tmp
    Next i
End Sub

Option Explicit
Const KeyWord As Integer = 777 '777 - это число является ключом к генерированию определенной последовательности
Const AlfaBet As String = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя1234567890"
                          
Sub Main()
    Dim S As String, St As String, i As Integer
    Cells(4, 1) = AlfaBet                'в ячейку А4 выводим  алфавит
    Cells(5, 1) = GetNewAlfaBet(KeyWord) 'в ячейку А5 выводим перемешанный алфавит
    
    'шифровка
    S = Cells(11, 1) 'берем строку из ячейки А11
    For i = 1 To Len(S)  'Заменяем символы строки символами нового алфавита
            St = St & Mid(AlfaBet, (InStr(1, GetNewAlfaBet(KeyWord), Mid(S, i, 1))), 1)
    Next i
    Cells(11, 2) = St 'зашифрованное слово выводим в ячейку В11
    St = ""
    
    'а теперь дещифровка
    S = Cells(11, 2) 'берем зашифрованную строку из ячейки B11
    For i = 1 To Len(S)  'Заменяем символы зашифрованной строки символами из алфавита
            St = St & Mid(GetNewAlfaBet(KeyWord), (InStr(1, AlfaBet, Mid(S, i, 1))), 1)
    Next i
    Cells(11, 3) = St 'дешифрованное слово выводим в ячейку С11
End Sub
 
'функция возвращает перемешанный алфавит
Private Function GetNewAlfaBet(key As Integer) As String
    Dim i As Integer, ArrAlfaBet() As String
    ReDim ArrAlfaBet(1 To Len(AlfaBet))
    For i = 1 To Len(AlfaBet)
        ArrAlfaBet(i) = Mid(AlfaBet, i, 1)
    Next i
    Unsort ArrAlfaBet, key
    GetNewAlfaBet = Join(ArrAlfaBet, "")
End Function
 
'Процедура перемешивания массива случайным образом
Private Sub Unsort(list() As String, key As Integer)
Dim i As Long
Dim pos As Long, min As Long
Dim tmp As String, max As Long
Rnd (-key)
min = LBound(list): max = UBound(list)
    For i = min To max - 1
        pos = Int((max - i + 1) * Rnd + i)
        tmp = list(pos)
        list(pos) = list(i)
        list(i) = tmp
    Next i
End Sub

Option Explicit
                          
Sub Main()
    Dim AlphaBet As String, NewAlphaBet As String, S As String, St As String, i As Integer
    
    AlphaBet = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя1234567890"
    NewAlphaBet = "фом3б5ы6уп9ъ2ёащлйючяэеивьтз4н0ш8с1кгж7дрхц"
    
    Cells(4, 1) = AlphaBet     'в ячейку А4 выводим  алфавит
    Cells(5, 1) = NewAlphaBet 'в ячейку А5 выводим перемешанный алфавит
 
    'шифровка
    S = Cells(11, 1) 'берем строку из ячейки А11
    For i = 1 To Len(S)  'Заменяем символы строки символами нового алфавита
            St = St & Mid(NewAlphaBet, (InStr(1, AlphaBet, Mid(S, i, 1))), 1)
    Next i
    Cells(11, 2) = St 'зашифрованное слово выводим в ячейку В11
    St = ""
    
    'а теперь дещифровка
    S = Cells(11, 2) 'берем зашифрованную строку из ячейки B11
    For i = 1 To Len(S)  'Заменяем символы зашифрованной строки символами из алфавита
            St = St & Mid(AlphaBet, (InStr(1, NewAlphaBet, Mid(S, i, 1))), 1)
    Next i
    Cells(11, 3) = St 'дешифрованное слово выводим в ячейку С11
End Sub