Новости:

К первому сообщению темы должен быть прикреплен файл примера в формате xls*.
Приложив пример, Вы избавите себя и других от вопросов типа "А какой критерий?", "А куда выводить результат?", "А сколько строк?" и все тех же просьб выложить файл. Рисовать за Вас Ваши же таблички с заданиями, а затем и решение к ним, никто желанием не горит. Да и, как показывает практика, в большинстве случаев без файла решения не найти.

Главное меню

Замедление работы команды Insert в VBA

Автор ping, 28.12.2011, 13:35

« назад - далее »

ping

Написал модуль вывода системных сообщений, так чтобы последнее сообщение было наверху, а старые сообщения спускались бы вниз.
Установил ограничение общего числа системных сообщений не более 1000, т.е. старые сообщения постепенно подчищаются.
Проблема в том, что первоначально (до первой 1000) сообщения записываются практически мгновенно, далее происходит замедление работы макроса, как-будто эксель держит в памяти уже удаленные сообщения.
Например, первоначально 1000 сообщений выводится за 50 сек. При втором запуске за 80 сек., при третьем за 110 сек. и т.д.
Что пробовал:
1) заменить range на rows  => без результата (замедление есть, но не такое активное)
2) сохранение документа, закрытие excel, перезагрузка компа во всех возможных сочетаниях положительного результата не дают (затупы сохраняются)
3) при проверке на превышение сообщений свыше 1000 можно дописать такую строку "z = ActiveSheet.UsedRange.Row" в таком случае excel не будет плодить пустые строки, которые почему-то висят в вертикальной прокрутке (и после каждого запуска примерного макроса увеличиваются на 1000) => в прилагаемом примере работа макроса стабилизируется, но в реальном макросе затупы остаются  :'(

Собственно вопросы:
1) как решить подобную задачу?
2) может кто-нибудь знает почему .Insert Shift:=xlDown постепенно замедляет работу в одинаковых условиях?
3) как почистить буфер куда, возможно, помещается информация при выполнении Insert?
4) как програмно отключить меню правка -> режим отмены действий?

Перекопал весь интернет. Заранее спасибо.

nilem

В Вашем коде некоторые строки закомментировал, некоторые - переставил. Попробуйте:
Option Explicit
'***Public WCore As Worksheet 'Все происходит на активном листе (и код у вас находится в модуле этого листа)
Sub start()
Dim t_start!, i&
'Set WCore = ThisWorkbook.Worksheets("CORE") '***точно определяем книгу и лист
Application.ScreenUpdating = False    ' выключаем обновление экрана
t_start = Timer
For i = 1 To 1000
    HistoryMsg 3, "Системное сообщение № " & i
Next i
Cells(1, 25) = Timer - t_start
Application.ScreenUpdating = True    ' включаем обновление экрана
Application.CutCopyMode = False    ' ***снимаем режим копирования ??
ActiveSheet.UsedRange

End Sub

Private Sub HistoryMsg(color As Byte, msg As String)  ' сдвиг истории сообщений
Range("A7:FG7").Copy    ' копируем последнее сообщение
Range("A8:FG8").Insert Shift:=xlDown    ' вставляем его со смещением предыдущих сообщений вниз
'Range("A7:FG7").Font.ColorIndex = color    '*** Если цвет один и тот же, то лучше установить его один раз
'Cells(7, 1) = Date    ' выводим дату - Дата вряд ли изменится за 40 сек.
Cells(7, 12) = Time    ' выводим время
Cells(7, 21) = msg    'выводим текущее сообщение
If Cells(1007, 1) <> "" Then Rows(1007).Delete   ' затираем последнее сообщение, что бы общее их число не превышало 1000
'DoEvents '??
End Sub