Страницы: 1
RSS
Зависает макрос "с шифром Виженера"
 
Добрый день! при шифровании листа с таблицей значений ( 150 столбцов и 2500 строк) Зависает макрос "Защита ячеек шифром Виженера" http://www.planetaexcel.ru/techniques/5/212/  . Так и должно быть? или сам что то не так делаю ( хотя моё участие в процессе шифрования - лишь в воде кода 1234  ;-) ) прошу ответить. спасибо
 
Цитата
Алексей Никифоров написал: Так и должно быть?
На таких объёмах - ДА, тормоза неизбежны. Посимвольный перебор - медленный процесс
Согласие есть продукт при полном непротивлении сторон.

Контакты, благодарности
 
Цитата
Sanja написал:
ДА, тормоза неизбежны
Не верю :-). не думаю, что там в каждой ячейке по томику "война и мир".  а 150x2500 то не так и много, а вот отключить обновления экрана, и калькуляцию мне кажетяс не сделано, ибо в  примере по ссылке этого нет.

Алексей Никифоров, попробуйте http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=100141&am... скорее всего разницу почувствуете.
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал: Не верю
однако это не отменяет того, что
Цитата
Sanja написал: Посимвольный перебор - медленный процесс
Согласие есть продукт при полном непротивлении сторон.

Контакты, благодарности
 
ВСЕМ спасибо за ответы. Уважаемый, БМВ!! А можно для меня одарённого - пояснить как эти обновления экрана и калькуляцию отключать/включать?  И макросы я обычно вставляю целиком, поэтому как их ускорить да еще и в коде VBA это уже за гранью моего опыта.(
 
попробуйте так.
Код
'Шифрование текущего листа
Sub Encrypt()
    Dim Pass$, Key$
    Pass = InputBox("Введите ключ для шифрования:")
    Key = WorksheetFunction.Rept(Pass, 100)
     
    With Application
        KeepCalc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
   For Each cell In Union(ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants), ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas))
            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
        .Calculation = KeepCalc
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
  
'Дешифрация текущего листа
Sub Decrypt()
    Dim Pass$, Key$
    Pass = InputBox("Введите ключ для расшифровки:")
    Key = WorksheetFunction.Rept(Pass, 100)
     
    With Application
        KeepCalc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
        For Each cell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
            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
        .Calculation = KeepCalc
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
Изменено: БМВ - 15.01.2018 14:25:46
По вопросам из тем форума, личку не читаю.
 
Опять Copy/Paste в 21-й строке...
Согласие есть продукт при полном непротивлении сторон.

Контакты, благодарности
 
СПАСИБО!!!!

там было пару опечаток ( ну я исправляю в силу своих пониманий : открыл исходный код, код по предоставленной ссылке и сравнивал ИЕРОГЛИФЫ на анлийскомпока не пропадет красный шрифт )))  )
всё работает раз в 20 быстрее - ну мне так показалось
пойду баловаться )))

спасибо!!
 
Цитата
Sanja написал:
Опять Copy/Paste в 21-й строке...
Да просто Ж.....  то кириллица, то CRLF.  
По вопросам из тем форума, личку не читаю.
 
простите но, новый код у меня не работает ((

до этого первый вариант, я чуть исправил опечатки, убрал все стили ячеек (привел к единому) - и все работало за 20-30 сек.шифровал и расшифровывал весь массив
а сейчас выдает ошибку (((

задача для меня то решена, но вот будущие пользователи Ваших трудов - будут в растерянности.;-)

да и хотелось бы не убирать заливку нужного массива цветом и условное форматирование не лишнее))
 
Цитата
Алексей Никифоров написал:
не убирать заливку нужного массива цветом и условное форматирование не лишнее
в коде ничего никто не убирает. меняется только содержимое ячеек, и  если условное форматирование меняется, так только по причинам того, что опорные значения не соответствуют ожидаемым после шифрации.
По вопросам из тем форума, личку не читаю.
 
Думаю, так пошустрее будет
Код
Sub Encrypt()
    Dim Pass$, Key$
    Dim ar
    Dim i&, j&, k&
    '    Pass = InputBox("Введите ключ для шифрования:")
    Pass = "ЗИМА"
    Key = WorksheetFunction.Rept(Pass, 100)
    With ActiveSheet.UsedRange
        ar = .Formula
        For i = LBound(ar) To UBound(ar)
            For j = LBound(ar, 2) To UBound(ar, 2)
                If Len(ar(i, j)) > Len(Key) Then
                    Key = WorksheetFunction.Rept(Pass, Len(ar(i, j)) \ Len(Pass) + 1)
                End If
                For k = 1 To Len(ar(i, j))
                    Mid$(ar(i, j), k, 1) = Chr((Asc(Mid(ar(i, j), k, 1)) + Asc(Mid(Key, k, 1))) Mod 256)
                Next
            Next
        Next
        .Cells(1).Resize(UBound(ar), UBound(ar, 2)).Value = ar
    End With
End Sub
Sub Decrypt()
    Dim Pass$, Key$
    Dim ar
    Dim i&, j&, k&
    '    Pass = InputBox("Введите ключ для расшифровки:")
    Pass = "ЗИМА"
    Key = WorksheetFunction.Rept(Pass, 100)
    With ActiveSheet.UsedRange
        ar = .Formula
        For i = LBound(ar) To UBound(ar)
            For j = LBound(ar, 2) To UBound(ar, 2)
                If Len(ar(i, j)) > Len(Key) Then
                    Key = WorksheetFunction.Rept(Pass, Len(ar(i, j)) \ Len(Pass) + 1)
                End If
                For k = 1 To Len(ar(i, j))
                    Mid$(ar(i, j), k, 1) = Chr((Asc(Mid(ar(i, j), k, 1)) - Asc(Mid(Key, k, 1)) + 256) Mod 256)
                Next k
            Next
        Next
        .Cells(1).Resize(UBound(ar), UBound(ar, 2)).Formula = ar
    End With
End Sub
 
RAN, я не на 100% уверен, но все зависит от размера области и данных в ней,  Если область рабочая очень большая, то чтение в массив может занять больше времени чем обработка, особенно если "формулы" короткие. Уже хочется экспериментировать c таймером :-)
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал: Уже хочется экспериментировать c таймером :-)
А мне интереснее про сохранение форматирования (в т.ч. условного) при использовании массива. И не только формата ВСЕЙ ячейки.Если ЧАСТЬ букав буде bold (например), то при выгрузке массива это не учтется. Но сегодня уже не хочется... :)  
Изменено: Sanja - 14.01.2018 22:16:24
Согласие есть продукт при полном непротивлении сторон.

Контакты, благодарности
 
Encrypt  0,547
Decrypt  0,336
Encrypt1  1,453
Decrypt1  1,102
 
RAN, убедили :-) так как потом все равно читаются данные из каждой ячейки, то массив выигрывает.

Меня вот смущает, что данные при расшифровке не все нормально восстанавливаются (метод не важен) :-)  просто цифры от 1 до 20 например .

Цитата
Sanja написал:
Если ЧАСТЬ букав буде bold (например),
так и без массива не учтется.
Изменено: БМВ - 14.01.2018 22:59:53
По вопросам из тем форума, личку не читаю.
 
RAN, я сначала затупил, и не понял что за цифры Вы написали. Теперь дошло-  Вы и правда секунды замерили )))
я с макросом в Примере который написан паролил 15 минут!!!!! а сейчас 30 секунд, единственное Ваш вариант с паролем внутри быстр, но с "кнопочками" для пароля - понадежнее  от взлома )))
очень помогли. - всем спасибо.
 
Цитата
Алексей Никифоров написал:
но с "кнопочками" для пароля - понадежнее  
это было для отладки отключено :-), чтоб не вводить каждый раз.

Вы вот с этим только осторожно
Цитата
БМВ написал:
Меня вот смущает, что данные при расшифровке не все нормально восстанавливаются (метод не важен) :-)  просто цифры от 1 до 20 например .
По вопросам из тем форума, личку не читаю.
 
дел
Изменено: WaleryN - 29.11.2023 16:18:16
Страницы: 1
Наверх