Увеличение скорости работы макроса скрытия строк.

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Увеличение скорости работы макроса скрытия строк. (Макросы/Sub)

Exsodus

Дата: Воскресенье, 02.04.2023, 11:27 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 11

Репутация: 0 ±

Замечаний: 0% ±

Здравствуйте. Подскажите пожалуйста, можно ли доработать макрос в приложенном файле? Макрос нашел в инете, по советам, немного доделал под себя. При запуске в рабочей таблице сильно тормозит, в приложенном файле тоже тормозит, но меньше. Может можно что-то сделать? Спасибо.

К сообщению приложен файл: 789.xlsm (106.5 Kb)

Ответить

Pelena

Дата: Воскресенье, 02.04.2023, 14:00 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 19403

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

Здравствуйте.
Попробуйте так: сначала объединить строки по условию в диапазон, а затем одним махом скрыть

К сообщению приложен файл: 7454769.xlsm (106.5 Kb)

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

i691198

Дата: Воскресенье, 02.04.2023, 14:16 | Сообщение № 3

Группа: Проверенные

Ранг: Обитатель

Сообщений: 337

Репутация: 108 ±

Замечаний: 0% ±

Exsodus, В основном тормозит пересчет формул. Ну и кое какие вычисления констант нужно выносить за пределы циклов. Попробуйте подправленный вариант вашего макроса "Hidden" (таймер не стал удалять, закомментировал, вдруг вам потребуется).
[vba]

Код

Sub Hidden()
   'Dim t
   Dim i%
   Dim Cl As Range, Rn As Range
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   't = Timer
   For i = 1 To 10
      With Sheets(i)
        Set Rn = .Range("C5:C" & .Cells(.Rows.Count, 3).End(xlUp).Row)
        For Each Cl In Rn
           If Cl.Value = 0 Then Cl.EntireRow.Hidden = True
        Next
      End With
    Next i
    't = Timer - t
    'MsgBox t
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

[/vba]

Ответить

Gustav

Дата: Воскресенье, 02.04.2023, 19:18 | Сообщение № 4

Группа: Админы

Ранг: Участник клуба

Сообщений: 2797

Репутация: 1161 ±

Замечаний: ±

начинал с Excel 4.0, видел 2.1

Еще на заметку - полуавтоматический способ: выделяем нужные строки вручную с помощью поиска по Ctrl+F, скрываем одной командой VBA.

I. РУЧНАЯ ЧАСТЬ:
1. выделить колонку C
2. вызвать диалог "Найти и заменить" по Ctrl+F
3. ввести искомое значение 0 в поле "Найти"
4. нажать кнопку "Найти все" и дождаться отработки команды
5. по Ctrl+A выделить все найденные места в нижней части окна поиска
6. закрыть диалог "Найти и заменить"

II. ЧАСТЬ VBA:
1. перейти в Окно отладки редактора VBA по Alt+F11 и далее Ctrl+G
2. ввести инструкцию:
[vba]

Код

Selection.EntireRow.Hidden = True

[/vba]
и нажать Enter

К сожалению, не нашёл, как можно было бы ручную часть полностью автоматизировать. Поэтому способ и "полуавтоматический".

МОИ: Ник, Tip box: 41001663842605

Ответить

Gustav

Дата: Воскресенье, 02.04.2023, 22:30 | Сообщение № 5

Группа: Админы

Ранг: Участник клуба

Сообщений: 2797

Репутация: 1161 ±

Замечаний: ±

начинал с Excel 4.0, видел 2.1

Автоматический способ. Не самый быстрый (аж четверть секунды), но мне нравящийся отсутствием цикла по ячейкам. Используется SpecialCells, которому для выделения подставляется в столбце справа от UsedRange (никому не мешая) врЕменная формула, возвращающая значение 1 в нужных строчках:

Код

=ЕСЛИ(И($C5=0;НЕ(ЕПУСТО($C5)));1;"")

После выделения и скрытия строк временный столбец автоматически удаляется (исходный UsedRange восстанавливается).
[vba]

Код

Sub Hidden3()
    Dim t, i As Integer
    Dim wks As Worksheet, rng As Range
    Application.ScreenUpdating = False
    t = Timer
    For i = 1 To 10
        Set wks = Sheets(i)
        Set rng = wks.UsedRange.Columns(wks.UsedRange.Columns.Count).Offset(0, 2)
        rng.FormulaR1C1 = "=IF(AND(RC3=0,NOT(ISBLANK(RC3))),1,"""")"
        On Error Resume Next
        rng.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Hidden = True '1 = Формулы \ Числа
        On Error GoTo 0
        rng.EntireColumn.Delete
    Next i
    t = Timer - t
    Debug.Print t 'about 0,25 sec
    Application.ScreenUpdating = True
End Sub

[/vba]

МОИ: Ник, Tip box: 41001663842605

Ответить

Увеличение скорости работы макроса скрытия строк. (Макросы/Sub)

Страница 1 из 1
1