Добрый день, всем участникам форума. Прошу Вас, по возможности, помочь, подсказать или послать где можно решение одного вопроса. Работаю с одним большим файлом (не получится приложить, даже не представляю как его можно вычистить чтобы сохранить структуру и соблюсти конфиденциальность, надеюсь получится подсказать без файла). Большой в плане количества столбцов и листов (юзеров не получилось убедить сократить кол-во столбцов). Один из листов который уже заполнен до столбца JY (+ нужно добавить еще 100 столбцов) зависает на заметное глазу время при просто внесении любого значения в ячейку. Нашел код который позволят вносить в этом листе информацию без торможения, но для этого я отключаю от авто пересчета всю книгу: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = ThisWorkbook.Sheets("Себ С и БЕЗ ВГО (ф 1.2.)").Range("A1:JY285")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _ Is Nothing Then
ThisWorkbook.Sheets("Себ С и БЕЗ ВГО (ф 1.2.)").Calculate
End If End Sub
[/vba] Можно ли каким-либо способом включить ручной режим пересчета только для отдельного листа? Разные способы которые нашел в интернете пробовал: 1. [vba]
Код
Sheets("Себ С и БЕЗ ВГО (ф 1.2.)").EnableCalculation = 0
[/vba] 2. сорри за ссылку, копировать много этот способо тоже пробовал 3. Этот способо не разобрался как вкрутить к себе И еще пара других способов пробовал - не сохранились. Буду признателен за любую подсказку как можно решить задачку. Как вариант может можно включать ручной пересчет при переходе на этот лист, а при выходе с этого листа в любой другой включать автоматический пересчет.
Добрый день, всем участникам форума. Прошу Вас, по возможности, помочь, подсказать или послать где можно решение одного вопроса. Работаю с одним большим файлом (не получится приложить, даже не представляю как его можно вычистить чтобы сохранить структуру и соблюсти конфиденциальность, надеюсь получится подсказать без файла). Большой в плане количества столбцов и листов (юзеров не получилось убедить сократить кол-во столбцов). Один из листов который уже заполнен до столбца JY (+ нужно добавить еще 100 столбцов) зависает на заметное глазу время при просто внесении любого значения в ячейку. Нашел код который позволят вносить в этом листе информацию без торможения, но для этого я отключаю от авто пересчета всю книгу: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = ThisWorkbook.Sheets("Себ С и БЕЗ ВГО (ф 1.2.)").Range("A1:JY285")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _ Is Nothing Then
ThisWorkbook.Sheets("Себ С и БЕЗ ВГО (ф 1.2.)").Calculate
End If End Sub
[/vba] Можно ли каким-либо способом включить ручной режим пересчета только для отдельного листа? Разные способы которые нашел в интернете пробовал: 1. [vba]
Код
Sheets("Себ С и БЕЗ ВГО (ф 1.2.)").EnableCalculation = 0
[/vba] 2. сорри за ссылку, копировать много этот способо тоже пробовал 3. Этот способо не разобрался как вкрутить к себе И еще пара других способов пробовал - не сохранились. Буду признателен за любую подсказку как можно решить задачку. Как вариант может можно включать ручной пересчет при переходе на этот лист, а при выходе с этого листа в любой другой включать автоматический пересчет.Anis625
Сообщение отредактировал Anis625 - Понедельник, 11.07.2022, 14:26
Обратил внимание что выше код работает если всю книгу включить в ручной пересчет. С этим кодом можно отключать/включать автопересчет формул при активации листа, но не отключает всю книгу от автопересчета [vba]
Код
Private Sub Worksheet_Activate() Application.Calculation = xlCalculationManual End Sub
Private Sub Worksheet_Deactivate() Application.Calculation = xlCalculationAutomatic End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.Calculation = xlCalculationAutomatic End Sub
[/vba] Но он работает в модуле листа.
Обратил внимание что выше код работает если всю книгу включить в ручной пересчет. С этим кодом можно отключать/включать автопересчет формул при активации листа, но не отключает всю книгу от автопересчета [vba]
Код
Private Sub Worksheet_Activate() Application.Calculation = xlCalculationManual End Sub
Private Sub Worksheet_Deactivate() Application.Calculation = xlCalculationAutomatic End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.Calculation = xlCalculationAutomatic End Sub
Sub FxlAutomatic() Application.Calculation = xlAutomatic End Sub Sub xlManual() Application.Calculation = FxlManual End Sub
[/vba] + в модуле листа[vba]
Код
Private Sub Worksheet_Activate() Call FxlManual End Sub -------------------------------------- Private Sub Worksheet_Deactivate() Call FxlAutomatic End Sub ------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range Set KeyCells = ThisWorkbook.Sheets("Себ С и БЕЗ ВГО (ф 1.2.)").Range("A1:JY285") If Not Application.Intersect(KeyCells, Range(Target.Address)) _ Is Nothing Then ThisWorkbook.Sheets("Себ С и БЕЗ ВГО (ф 1.2.)").Calculate End If End Sub
[/vba]
Получилось реализовать так: В модуле[vba]
Код
Sub FxlAutomatic() Application.Calculation = xlAutomatic End Sub Sub xlManual() Application.Calculation = FxlManual End Sub
[/vba] + в модуле листа[vba]
Код
Private Sub Worksheet_Activate() Call FxlManual End Sub -------------------------------------- Private Sub Worksheet_Deactivate() Call FxlAutomatic End Sub ------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range Set KeyCells = ThisWorkbook.Sheets("Себ С и БЕЗ ВГО (ф 1.2.)").Range("A1:JY285") If Not Application.Intersect(KeyCells, Range(Target.Address)) _ Is Nothing Then ThisWorkbook.Sheets("Себ С и БЕЗ ВГО (ф 1.2.)").Calculate End If End Sub
Private Sub Worksheet_Activate() Application.Calculation = xlManual End Sub
Private Sub Worksheet_Deactivate() Application.Calculation = xlAutomatic End Sub
Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range Set KeyCells = ThisWorkbook.Sheets("наименование листа").Range("A1:JY285") If Not Application.Intersect(KeyCells, Range(Target.Address)) _ Is Nothing Then ThisWorkbook.Sheets("наименование листа").Calculate End If End Sub
[/vba]
Сократил, сразу зашиваем в модуль листа:[vba]
Код
Private Sub Worksheet_Activate() Application.Calculation = xlManual End Sub
Private Sub Worksheet_Deactivate() Application.Calculation = xlAutomatic End Sub
Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range Set KeyCells = ThisWorkbook.Sheets("наименование листа").Range("A1:JY285") If Not Application.Intersect(KeyCells, Range(Target.Address)) _ Is Nothing Then ThisWorkbook.Sheets("наименование листа").Calculate End If End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
