Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Увеличение скорости работы макроса скрытия строк. - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Увеличение скорости работы макроса скрытия строк.
Exsodus Дата: Воскресенье, 02.04.2023, 11:27 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Здравствуйте. Подскажите пожалуйста, можно ли доработать макрос в приложенном файле? Макрос нашел в инете, по советам, немного доделал под себя. При запуске в рабочей таблице сильно тормозит, в приложенном файле тоже тормозит, но меньше. Может можно что-то сделать? Спасибо.
К сообщению приложен файл: 789.xlsm (106.5 Kb)
 
Ответить
СообщениеЗдравствуйте. Подскажите пожалуйста, можно ли доработать макрос в приложенном файле? Макрос нашел в инете, по советам, немного доделал под себя. При запуске в рабочей таблице сильно тормозит, в приложенном файле тоже тормозит, но меньше. Может можно что-то сделать? Спасибо.

Автор - Exsodus
Дата добавления - 02.04.2023 в 11:27
Pelena Дата: Воскресенье, 02.04.2023, 14:00 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19392
Репутация: 4537 ±
Замечаний: ±

Excel 365 & Mac Excel
Здравствуйте.
Попробуйте так: сначала объединить строки по условию в диапазон, а затем одним махом скрыть
К сообщению приложен файл: 7454769.xlsm (106.5 Kb)


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеЗдравствуйте.
Попробуйте так: сначала объединить строки по условию в диапазон, а затем одним махом скрыть

Автор - Pelena
Дата добавления - 02.04.2023 в 14:00
i691198 Дата: Воскресенье, 02.04.2023, 14:16 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 324
Репутация: 104 ±
Замечаний: 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]
 
Ответить
Сообщение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]

Автор - i691198
Дата добавления - 02.04.2023 в 14:16
Gustav Дата: Воскресенье, 02.04.2023, 19:18 | Сообщение № 4
Группа: Админы
Ранг: Участник клуба
Сообщений: 2790
Репутация: 1154 ±
Замечаний: ±

начинал с 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
 
Ответить
СообщениеЕще на заметку - полуавтоматический способ: выделяем нужные строки вручную с помощью поиска по 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

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

Автор - Gustav
Дата добавления - 02.04.2023 в 19:18
Gustav Дата: Воскресенье, 02.04.2023, 22:30 | Сообщение № 5
Группа: Админы
Ранг: Участник клуба
Сообщений: 2790
Репутация: 1154 ±
Замечаний: ±

начинал с 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
 
Ответить
СообщениеАвтоматический способ. Не самый быстрый (аж четверть секунды), но мне нравящийся отсутствием цикла по ячейкам. Используется 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]

Автор - Gustav
Дата добавления - 02.04.2023 в 22:30
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!