Защита ячеек шифром Виженера

Парольная защита листов в Microsoft Excel давно стала притчей во языцех. В том плане, что ее, по-сути, нет. С регулярностью примерно раз в месяц я получаю вопросы по почте на тему "как мне защитить мои данные на листе Excel от просмотра/изменения?" и каждый раз не знаю что ответить. Можно, конечно, дать ссылочку на статью с подробным описанием всех способов защиты ячеек и листов в Excel, но такая защита остановит только начинающего. В сети можно найти кучу платных и бесплатных программ для взлома такой защиты тупым перебором за считанные минуты.

В какой-то момент мне это надоело и я стал искать способы более надежной защиты данных в Excel собственными силами. Самым простым и удобным оказался шифр Виженера.

Принцип шифра Виженера

Одним из самых древних и простых в реализации является шифр Цезаря, который использовал его для тайной переписки. Суть его в том, что каждая буква исходного шифруемого сообщения сдвигается в алфавите на заданное количество символов. Так, например, если сдвиг равен 3, то буква А превратится в Г, буква Б - в Д и так далее:

Шифр Цезаря

Символы в конце алфавита (Э, Ю, Я), соответственно, будут превращаться его начало (А, Б, В).

Реализовать такой шифр просто, но стойкость его невелика - найти нужное число сдвига и дешифровать сообщение можно даже прямым перебором за 20-30 итераций, что займет даже у человека не больше часа, а у современного компьютера доли секунды. Поэтому еще в 15 веке был впервые придуман, а потом в 16 веке французским дипломатом Блезом Виженером официально представлен более совершенный метод на основе шифра Цезаря, получивший впоследствии название "шифр Виженера". Его принцип в том, что каждая буква в исходном шифруемом тексте сдвигается по алфавиту не на фиксированное, а переменное количество символов. Величина сдвига каждой буквы задается ключом (паролем) - секретным словом или фразой, которая используется для шифрования и расшифровки. 

Допустим, мы хотим зашифровать фразу "КЛАД ЗАРЫТ В САДУ" используя слово ЗИМА в качестве ключа. Запишем это слово подряд несколько раз под исходной фразой:

vigenere-encription2.png

Для удобства шифрования используем так называемый "квадрат Виженера" - таблицу, где в каждой строке алфавит сдвигается на одну позицию вправо:

квадрат виженера

Если взять строку с первой буквой ключа (З) и столбец с первой буквой исходного текста (К), то на их пересечении увидим букву "Т" - это и будет первая буква нашего зашифрованного сообщения. Затем процедура повторяется для всех остальных пар букв ключа и исходного сообщения по очереди и в результате мы получаем зашифрованный вариант нашей исходной фразы:

шифр виженера результат

Заметьте, что одна и та же буква (например А) в исходном сообщений превратилась в разные буквы на выходе (Н, Й и Б), т.к. сдвиг при шифровании для них был разный. Именно поэтому вскрыть шифр Виженера простыми способами невозможно - вплоть до 19 века он считался невзламываемым и успешно использовался военными, дипломатами и шпионами многих стран, частности - конфедератами во время Гражданской войны в США.

Реализация формулами по квадрату Виженера

Если использовать готовый квадрат Виженера как в примере выше, то реализовать шифрование можно одной формулой с помощью функций ИНДЕКС (INDEX) и ПОИСКПОЗ (MATCH), как это было описано в статье про двумерный поиск в таблице. Выглядеть это может примерно так:

vigenere-encription5.png

Логика этой формулы следующая:

  • Первая функция ПОИСКПОЗ (подсвечена зеленым) ищет первую букву ключа (З) в зеленом столбце (B9:B40) и выдает порядковый номер ячейки, где она ее нашла, т.е. номер строки в квадрате Виженера по которому идет шифрование.
  • Вторая функция ПОИСКПОЗ (подсвечена розовым) аналогичным образом ищет первую букву исходного сообщения (К) в красной строке и выдает порядковый номер столбца.
  • Функция ИНДЕКС выдает содержимое ячейки из квадрата (C9:AH40) с пересечения строки и столбца с найденными номерами.

Реализация формулами по кодам символов

Легко сообразить, что в реальной жизни в документах могут использоваться не только буквы русского языка, но и латиница, цифры, знаки препинания и т.д. Делать квадрат Виженера с участием всех этих символов - та еще эпопея, но есть другой, гораздо более простой способ.

Внутри компьютера и операционной системы каждый символ имеет свой числовой код от 0 до 255 (его еще называют ASCII-кодом). Microsoft Excel имеет в своем стандартном наборе две функции, которые умеют с ними работать:

  • Функция КОДСИМВ (CODE) - выдает числовой код символа, указанного в качестве аргумента. Например КОДСИМВ("Ж") выдаст 198.
  • Функция СИМВОЛ (CHAR) - выдает символ, соответствующий указанному в аргументе коду, т.е. наоборот СИМВОЛ(198) даст нам букву Ж. 

Для применения шифра Виженера запишем наш исходный текст и ключ друг под другом как раньше и выведем коды каждой буквы с помощью функции КОДСИМВ:

vigenere-encription6.png

Теперь сложим коды символов ключа и исходного текста, добавив функцию ОСТАТ (MOD), чтобы при превышении максимально допустимого количества символов (256) остаться в пределах 0-255:

vigenere-encription7.png

Теперь осталось использовать функцию СИМВОЛ, чтобы вывести символы по полученным кодам и сформировать зашифрованное сообщение:

vigenere-encription8.png

Само-собой, можно было бы обойтись и без дополнительных строк, уложив все функции в одну формулу для компактности:

vigenere-encription9.png

Расшифровка производится совершенно аналогично, только знак "плюс" в формуле меняется на "минус":

vigenere-encription10.png

Для шпионских игр шифрование такими спецсимволами, конечно, не очень удобно - так и представляю себе глаза радистки Кэт при попытке передать третий и пятый символы нашей шифровки :) Но нам их, отстреливаясь из именного ТТ во время погони, на бумажке не писать, так что для наших целей - сойдет.

Макросы для шифрования-дешифрования

Ну, а теперь самое интересное. Чтобы применить шифр Виженера в реальной жизни лучше будет воспользоваться простым макросом, который проводит все описанные в предыдущем пункте операции с каждой ячейкой текущего листа автоматически. Откройте редактор Visual Basic с помощью сочетания клавиш Alt+F11 или кнопкой Visual Basic на вкладке Разработчик (Developer). Вставьте новый модуль с помощью команды меню Insert - Module и скопируйте туда текст наших макросов:

 
'Шифрование текущего листа
Sub Encrypt()
    Dim Pass$, Key$
    Pass = InputBox("Введите ключ для шифрования:")
    Key = WorksheetFunction.Rept(Pass, 100)
    
    For Each cell In ActiveSheet.UsedRange
        Out = ""
        Txt = cell.Formula
        For i = 1 To Len(Txt)
            Out = Out & Chr((Asc(Mid(Txt, i, 1)) + Asc(Mid(Key, i, 1))) Mod 256)
        Next i
        cell.Value = Out
    Next cell
End Sub

'Дешифрация текущего листа
Sub Decrypt()
    Dim Pass$, Key$
    Pass = InputBox("Введите ключ для расшифровки:")
    Key = WorksheetFunction.Rept(Pass, 100)
    
    For Each cell In ActiveSheet.UsedRange
        Out = ""
        Txt = cell.Value
        For i = 1 To Len(Txt)
            Out = Out & Chr((Asc(Mid(Txt, i, 1)) - Asc(Mid(Key, i, 1)) + 256) Mod 256)
        Next i
        cell.Formula = Out
    Next cell
End Sub
 

Первый макрос запрашивает у пользователя ключ и шифрует все ячейки текущего листа. Второй макрос производит обратную операцию дешифрования. Запустить получившиеся макросы можно с помощью сочетания клавиш Alt+F8 или кнопки Макросы (Macros) на вкладке Разработчик (Developer). Выглядеть все это может примерно так:

vigenere-encryption11.gif

Важные нюансы

  • ВНИМАНИЕ! Если вы внимательно прочитали статью, то должны четко понимать - не существует легкого способа узнать или подобрать ключ! Есть несколько методик взлома шифра Виженера, но все они весьма сложны для неспециалиста и не дают 100% гарантии. Если вы забудете ключ - потеряете данные навсегда с большой вероятностью. Если что - я вас предупредил.
  • При шифровании не нарушаются формулы, ссылки и форматирование - после дешифрации все отлично работает.
  • Если при дешифрации вы неправильно введете ключ, то получите бессмысленную "кашу" из спецсимволов вместо своего текста (т.к. сдвиг кодов будет неправильным). Тогда придется откатиться на шаг назад повторным шифрованием с тем же паролем и потом снова попробовать расшифровать документ еще раз (на этот раз используя правильный ключ).

Ссылки по теме

 



01.12.2014 21:37:22
Отличный способ, спасибо!
Из замеченного:
1 - Гиперссылки визуально шифруются, но в теле остаются неизменными, т.е по ним можно спокойно переходить. Можно добавить к важным нюансам
2 - При дешифровке неполным словом, например ключ "Зима",а при дешифровке введено "Зим", то первые символы слов будут отображаться правильно ;)
3 -  Регистр имеет значение. Тоже можно к нюансам
01.12.2014 23:32:27
Про гиперссылки - спасибо, надо подумать как обойти.
Про п.2 - само собой, поскольку часть пароля верная.
Про п.3 - само собой, как и любой пароль в ОС, интернете и т.д.
01.12.2014 22:22:18
Спасибо огромное,Николай.
Если при дешифрации вы неправильно введете ключ, то получите 
бессмысленную "кашу" из спецсимволов вместо своего текста (т.к. сдвиг 
кодов будет неправильным). Тогда придется откатиться на шаг назад 
повторным шифрованием с тем же паролем и потом снова попробовать 
расшифровать документ еще раз (на этот раз используя правильный ключ).  
1. Запускаю Encrypt. Вношу пароль: фыва
2. Запускаю Decrypt. Вношу пароль:фыв Итог: "каша"
3. Опять Запускаю Encrypt. Вношу пароль: фыва
4. Запускаю Decrypt. Вношу пароль:фыва Итог: "каша" Почему? Что не верно делаю если кто-то другой внесет неверный пароль, а я потом захочу восстановить данные?
Возможно в коде поставить msgbox, если пароль при внесении будет неверный?
Заранее спасибо
01.12.2014 23:29:30
В п.3 должен быть пароль "фыв".
Msgbox поставить можно, но как узнать какой пароль верный, а какой нет?
02.12.2014 09:29:11
Спасибо большое, статья очень интересная. Но учитывая, что данные шифруются от стороннего пользователя, то может возникнуть такая ситуация, когда кто то пытаясь расшифровать информацию введет любое не верное ключевое слово. Естественно у него ничего не получиться. Он сохранит этот результат. Когда же я введу верное слово, то данные не расшифруются и будут потеряны навсегда((((. Этот момент можно предусмотреть?
02.12.2014 10:23:04
Алексей, суть шифрования не в защите данных от повреждения, а в невозможности прочитать информацию чужим людям. Предполагается, что с этим файлом не будут работать совместно несколько пользователей, а вы сохраняете в нем конфиденциальную информацию, которая не должна попасть в руки чужим людям. А если попадет - то они не должны ее прочесть.
02.03.2016 20:09:49
Бэкап - спасение человечества. Важные данные - в надежное место.
02.12.2014 10:20:25
На крупных массивах шифрует 1/4 часть и ругается на
cell.Value = Out

в чем может быть проблема?
02.12.2014 10:26:05
Геннадий, думаю дело не в массиве, а в том, что макрос натыкается на символ, который после сдвига шифром становится недопустимым или невоспроизводимым для Excel в ячейке. Если пришлете файл на почту - посмотрю и попробую решить проблему.
02.12.2014 11:53:56
Отправил на почту ;)
02.12.2014 13:38:47
Если в ключе есть буква "q", то макрос завершается ошибкой в строке  cell.Value = Out. Вероятно ошибка вызвана тем, что русская буква "М" с ключем "q", преобразуется в знак "=",  и если "М" первая, то зашифрованное слово превращается в формулу "=.... и. т.д.", что вызывает ошибку :(
02.12.2014 14:50:30
Спасибо, подумаю как поправить.
02.12.2014 13:58:45
Осталось только реализовать это в PLEX  :)
02.12.2014 14:49:40
В PLEX нельзя - по закону на продажу программных продуктов с любыми средствами шифрования нужна лицензия ФСБ :(
Специально у юристов интересовался.
При дешифрации часть данных из ячеек просто пропадает
03.12.2014 13:25:02
Файл в студию (в смысле - на почту) :)
04.12.2014 10:53:32
Долго перебирает, ошибка cell.Value = Out, и съедает данные при обратной дешефрации
MCH
06.12.2014 13:29:18
1. Нет обхода формул массива введеных в несколько ячеек единовременно
2. Формула массива введеная в одну ячейку преобразуется в обычную формулу
3. Повтор последовтельности ключа всего 100 раз, при малых паролях не возможно будет зашифровать длинные тексты/формулы
4. mod 256 подразумевает, что может получится 0, а chr(0) обрезает текстовую строку
5. если в ячейке было число, записанное как текст, то после обратной расшифровки текст становится числом

Предложения:
Избегать ситуации, что после шифрации на 1 месте окажется знак "="
По разному обрабатывать текстовые значения, формулы массива и обычные формулы.
Обрабатывать только печатные символы (больше или равные пробелу), при этом символы с кодом до 32 можно использовать  для определения правильной расшифровки chr(1) - в ячейке была константа, chr(2) - в ячейке была формула, chr(3) - в ячейке была формула массива.
MCH
06.12.2014 14:38:00
попытался учесть вышеизложенные замечания:
Option Explicit

'Шифрование текущего листа
Sub Encrypt()
    Dim key$, ac&, rng As Range
    On Error Resume Next
    ac = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    key = InputBox("Введите ключ для шифрования:")
    For Each rng In ActiveSheet.UsedRange
        If rng.HasArray Then
            If rng.CurrentArray.Count = 1 Then rng.Value = Chr$(31) & MyEncrypt(rng.Formula, key)
        ElseIf rng.HasFormula Then
            rng.Value = Chr$(30) & MyEncrypt(rng.Formula, key)
        Else
            If Not IsEmpty(rng) Then rng.Value = Chr$(29) & MyEncrypt(rng.Formula, key)
        End If
    Next rng
    
    Application.ScreenUpdating = True
    Application.Calculation = ac
End Sub

'Дешифрация текущего листа
Sub Decrypt()
    Dim key$, ac&, rng As Range
    On Error Resume Next
    ac = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    key = InputBox("Введите ключ для расшифровки:")
    For Each rng In ActiveSheet.UsedRange
        If Not rng.HasArray Then
            Select Case Asc(Left$(rng.Value, 1))
            Case 30: rng.Formula = MyDecrypt(Mid$(rng.Value, 2), key)
            Case 31: rng.FormulaArray = MyDecrypt(Mid$(rng.Value, 2), key)
            Case Else: If Not IsEmpty(rng) Then rng.Formula = MyDecrypt(Mid$(rng.Value, 2), key)
            End Select
        End If
    Next rng
    
    Application.ScreenUpdating = True
    Application.Calculation = ac
End Sub

Function MyEncrypt$(txt$, key$)
    Dim i&, a&, l&, out$
    l = Len(key)
    If l = 0 Then MyEncrypt = txt: Exit Function
    For i = 1 To Len(txt)
        a = Asc(Mid$(txt, i, 1))
        If a >= 32 Then a = (a - 32 + Asc(Mid$(key, (i - 1) Mod l + 1, 1))) Mod 224 + 32
        out = out & Chr$(a)
    Next i
    MyEncrypt = out
End Function

Function MyDecrypt$(txt$, key$)
    Dim i&, a&, l&, out$
    l = Len(key)
    If l = 0 Then MyDecrypt = txt: Exit Function
    For i = 1 To Len(txt)
        a = Asc(Mid$(txt, i, 1))
        If a >= 32 Then a = (a - 32 - Asc(Mid$(key, (i - 1) Mod l + 1, 1)) + 224) Mod 224 + 32
        out = out & Chr$(a)
    Next i
    MyDecrypt = out
End Function
06.12.2014 17:21:06
Спасибо как всегда, МСН! Правда, вот именно такого здоровенного кода я и пытался избежать, но пока не придумал как решить это компактнее. Буду продолжать.
04.01.2015 17:19:27
Очень здоровски. Классные макросы. Низкий поклон за них =)

Но где-то есть проблемки в этом коде.
1) Если в окне "Ввода кода для шифрования/дешифрования" нажать отмена или оставить поле пустым, то во всех ячейках съедается первый символ.
3) Если в качестве пароля использовать слово из кириллицы то при дешифрации некоторые символы остаются зашифрованными.

Было бы очень здорово, если Вы сможете внести эти корректировки.:)
MCH
05.01.2015 14:55:33
Замечания по моему коду?
по первому вопросу: можно выходить из процедуры если введен ключ нулевой длины, либо в процедуре Decrypt() немного измените код, чтобы не съедался первый символ:
            Select Case Asc(Left$(rng.Value, 1))
            Case 29, 30: rng.Formula = MyDecrypt(Mid$(rng.Value, 2), key)
            Case 31: rng.FormulaArray = MyDecrypt(Mid$(rng.Value, 2), key)
            Case Else: If Not IsEmpty(rng) Then rng.Formula = MyDecrypt(rng.Value, key)
            End Select


По второму (третьему) вопросу
в функции MyDecrypt нужно также немного изменить код:
If a >= 32 Then a = (a - 32 - Asc(Mid$(key, (i - 1) Mod l + 1, 1)) + 448) Mod 224 + 32


привожу весь код с исправлениями
'Шифрование текущего листа
Sub Encrypt()
    Dim key$, ac&, rng As Range
    On Error Resume Next
    ac = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    key = InputBox("Введите ключ для шифрования:")
    For Each rng In ActiveSheet.UsedRange
        If rng.HasArray Then
            If rng.CurrentArray.Count = 1 Then rng.Value = Chr$(31) & MyEncrypt(rng.Formula, key)
        ElseIf rng.HasFormula Then
            rng.Value = Chr$(30) & MyEncrypt(rng.Formula, key)
        Else
            If Not IsEmpty(rng) Then rng.Value = Chr$(29) & MyEncrypt(rng.Formula, key)
        End If
    Next rng
    
    Application.ScreenUpdating = True
    Application.Calculation = ac
End Sub

'Дешифрация текущего листа
Sub Decrypt()
    Dim key$, ac&, rng As Range
    On Error Resume Next
    ac = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    key = InputBox("Введите ключ для расшифровки:")
    For Each rng In ActiveSheet.UsedRange
        If Not rng.HasArray Then
            Select Case Asc(Left$(rng.Value, 1))
            Case 29, 30: rng.Formula = MyDecrypt(Mid$(rng.Value, 2), key)
            Case 31: rng.FormulaArray = MyDecrypt(Mid$(rng.Value, 2), key)
            Case Else: If Not IsEmpty(rng) Then rng.Formula = MyDecrypt(rng.Value, key)
            End Select
        End If
    Next rng
    
    Application.ScreenUpdating = True
    Application.Calculation = ac
End Sub

Function MyEncrypt$(txt$, key$)
    Dim i&, a&, l&, out$
    l = Len(key)
    If l = 0 Then MyEncrypt = txt: Exit Function
    For i = 1 To Len(txt)
        a = Asc(Mid$(txt, i, 1))
        If a >= 32 Then a = (a - 32 + Asc(Mid$(key, (i - 1) Mod l + 1, 1))) Mod 224 + 32
        out = out & Chr$(a)
    Next i
    MyEncrypt = out
End Function

Function MyDecrypt$(txt$, key$)
    Dim i&, a&, l&, out$
    l = Len(key)
    If l = 0 Then MyDecrypt = txt: Exit Function
    For i = 1 To Len(txt)
        a = Asc(Mid$(txt, i, 1))
        If a >= 32 Then a = (a - 32 - Asc(Mid$(key, (i - 1) Mod l + 1, 1)) + 448) Mod 224 + 32
        out = out & Chr$(a)
    Next i
    MyDecrypt = out
End Function
08.12.2014 09:35:50
Если в начале строки пробелы то он их шифрует а потом не дешефрует. И еще какие то символы жрет.
15.12.2014 00:24:33
Добрый день. Посмотрел несколько Ваших уроков по Excel мне понравилось. Подскажите пожалуйста где можно приобрести книгу "Microsoft Excel: готовые решения - бери и пользуйся!" + задания к ней на Украине?

PS Написал на почту но ответ так и не получил(
27.12.2014 23:39:15
На Украине пока сложно. Только если заказать международную доставку на том же "Озоне", но выйдет дороговато, к сожалению.
02.01.2015 08:21:28
Хорошая идея для статьи! Жаль не мне пришла в голову :)
13.01.2015 15:41:18
Очень умно! Спасибо!
11.02.2015 11:35:58
При шифровке "УМНОЙ ТАБЛИЦЫ" строка заголовков зашифровывается а назад расшифровывается неправильно, некоторые или даже все символы не восстанавливаются.
Остальные строки в таблице расшифровываются правильно.
26.02.2015 12:07:55
Друзья, классная штука!! Спасибо и низкий поклон.

Только что нужно изменить в коде, что макрос работал каждом листе. Названиям функций дать идентификатор листа? Каша получается...
05.04.2015 20:12:25
Доброго времени!
спасибо за очередную прекрасную статью!
Из-за нее полез подробнее почитать про механизмы взлома шифра Виженера. Как оказалось, стойкость этого шифра далека от высокой. Весьма практическая статья на хабре с готовой программой по взлому (в течении 10 сек) алгоритма Виженера http://habrahabr.ru/post/221485/
Не сочтите пожалуйста за критику Вашего материала. Скорее критика самого алгоритма шифрования.
Спасибо за Ваш сайт и шикарные материалы!
С уважением.
20.05.2015 14:50:15
Не за что :) Шифр, действительно, не суперстойкий, но для бытовых нужд вполне сойдет. Мне интересно было (для себя в большей степени) реализовать механизм такого шифрования в Excel. А уж если кому еще пригодится - совсем хорошо.
20.05.2015 09:58:02
Взломать можно что угодно! А тот, кто ломать будет, ещё должен знать, по крайней мере, что это шифр Виженера, а не что-то ещё.
Вы же не будете вешать ярлык, что лист зашифрован именно кодом Виженера:D
08.07.2015 14:33:38
Николай, тема хорошая я по серьезному взял в работу, НО! вылез один касяк попробуй зашифровать слово ИЗОЛЬДА (заглавными буквами) с ключем 8925 а потом разшифровать. В итоге слово изчезнет.  Более конкретно касяки идут когда шифруем
"И" ключем 8,
"З" ключем 9
"О" ключем 2  
"Р" ключем 0
"Л" ключем 5
Все из за того что результат вычислений суммы символов дает значение 256 ну и как следствие код символа который нужно возпроизвести =0
При расчете формулой идет ошибка при расчете макросом значения изчезают вовсе.
Буду признателен если придумаешь как поченить.
14.04.2016 13:13:00
и наоборот тоже: шифровал массив с числами словом "ЗИМА" (как в примере), часть 8ок и 9ок исчезла.
12.06.2017 15:25:42
А еще можно и примечания шифровать.
Добавлено к коду MCH.

'Шифрование текущего листа
Sub Encrypt()
    Dim key$, ac&, rng As Range
    On Error Resume Next
    ac = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    key = InputBox("Введите ключ для шифрования:")
    For Each rng In ActiveSheet.UsedRange
        If rng.HasArray Then
            If rng.CurrentArray.Count = 1 Then rng.Value = Chr$(31) & MyEncrypt(rng.Formula, key)
        ElseIf rng.HasFormula Then
            rng.Value = Chr$(30) & MyEncrypt(rng.Formula, key)
        Else
            If Not IsEmpty(rng) Then rng.Value = Chr$(29) & MyEncrypt(rng.Formula, key)
        End If
    Next rng
        
    On Error Resume Next
    Dim prim As String, prim_key As String
        For Each rng In ActiveSheet.UsedRange
         If Not rng.Comment Is Nothing Then
                prim_key = Chr$(29) & MyEncrypt(Примечание(rng), key)
                rng.NoteText Text:=prim_key
         End If
        Next rng
        
    Application.ScreenUpdating = True
    Application.Calculation = ac
End Sub

'Дешифрация текущего листа
Sub Decrypt()
    Dim key$, ac&, rng As Range
    On Error Resume Next
    ac = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    key = InputBox("Введите ключ для расшифровки:")
    For Each rng In ActiveSheet.UsedRange
        If Not rng.HasArray Then
            Select Case Asc(Left$(rng.Value, 1))
            Case 29, 30: rng.Formula = MyDecrypt(Mid$(rng.Value, 2), key)
            Case 31: rng.FormulaArray = MyDecrypt(Mid$(rng.Value, 2), key)
            Case Else: If Not IsEmpty(rng) Then rng.Formula = MyDecrypt(rng.Value, key)
            End Select
        End If
    Next rng
    
    On Error Resume Next
    Dim prim As String, prim_key As String
        For Each rng In ActiveSheet.UsedRange
         If Not rng.Comment Is Nothing Then
                prim_key = MyDecrypt(Mid$(Примечание(rng), 2), key)
                rng.NoteText Text:=prim_key
         End If
        Next rng
        
    Application.ScreenUpdating = True
    Application.Calculation = ac
End Sub

Private Function Примечание(rCell As Range) As String

Do
     iTempText$ = rCell.NoteText(Start:=iCount% * 255 + 1)
     iNoteText$ = iNoteText$ & iTempText$
     iCount% = iCount% + 1
Loop While iTempText$ <> ""

Примечание = iNoteText$

End Function

Function MyEncrypt$(txt$, key$)
    Dim i&, a&, l&, out$
    l = Len(key)
    If l = 0 Then MyEncrypt = txt: Exit Function
    For i = 1 To Len(txt)
        a = Asc(Mid$(txt, i, 1))
        If a >= 32 Then a = (a - 32 + Asc(Mid$(key, (i - 1) Mod l + 1, 1))) Mod 224 + 32
        out = out & Chr$(a)
    Next i
    MyEncrypt = out
End Function

Function MyDecrypt$(txt$, key$)
    Dim i&, a&, l&, out$
    l = Len(key)
    If l = 0 Then MyDecrypt = txt: Exit Function
    For i = 1 To Len(txt)
        a = Asc(Mid$(txt, i, 1))
        If a >= 32 Then a = (a - 32 - Asc(Mid$(key, (i - 1) Mod l + 1, 1)) + 448) Mod 224 + 32
        out = out & Chr$(a)
    Next i
    MyDecrypt = out
End Function
07.12.2017 11:00:30
Добрый день. Возможно ли применить данный макрос для шифрования документа Word? Что нужно изменить в коде, чтобы это сделать?
12.02.2018 02:44:39
Здравствуйте.
Подскажите, пожалуйста, что подправить в макросе Николая, чтобы зашифрованный текст состоял только из цифр и английских букв?
19.04.2018 15:34:48
Необходимо ещё иметь в виду, что в Excel мы имеем дело не просто с текстом, а с таблицей - со структурированными повторяющимися данными известной длины.
Поэтому для взлома шифра стандартные методики взлома шифра Вижинера, основанные на частотном анализе и т.п., не потребуются в большинстве случаев. Достаточно просто вдумчиво проанализировать зашифрованную таблицу на предмет того, какие слова и какой длины мы ожидаем там увидеть. Если хотя бы одно слово (например, "отчёт" или "Москва" в рассматриваемом примере) будет предсказано верно (а мы можем это проверить, получив вычетом часть пароля и применив её ко всему тексту), то дальше шифр просто раскалывается как орех по известным частям пароля.

Чтобы избежать этого я бы предложил шифр "посолить". Т.е. добавить к зашифрованному тексту в заданной позиции набор рандомных символов рандомной длины. А при дешифровке эту лишнюю часть обрезать. Длину соли можно определять, например, по остатку от деления первого символа. Несложная операция, однако, повысит стойкость данного шифра хотя бы до уровня, когда его нельзя разгадать как кроссворд.
Leo
28.01.2021 14:55:49
Спасибо за скрипт!
У меня некорректно шифрует ячейки с содержимым -"РСУ", после декрипта - "ЮФ". Пароль использовал "Table3".
Leo
28.01.2021 15:08:03
Код от "lis2109 12.06.2017 15:25:42" работает без ошибки. Спасибо!
08.11.2023 08:20:04
Круто!)
Есть потребность в шифровании  имен файлов.
Операционная система запрещает использование некоторых служебных символов в именах файлов.
Подскажите пожалуйста как изменить код что би после шифрования исключить появление таких служебных символов? Спасибо!
Наверх