Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Скрыть/отобразить строки по условию, С помощью кода VBA скрыть/отобразить строки на листе
 
#1
06.11.2018 17:22:00
С добрым днем! Нужна помощь специалистов, кто сталкивался или может помочь решить проблему с очень медленным выполнением кода. Общая задача такая - при выборе галкой комплектующего показываются его параметры, при снятии галки - скрываются. Реализовал через заполнение по формуле каждой строчки столбца "A", если в ячейке значение "2", то она скрывается, если нет, то отображается. В оригинале файла все данные заполняются по формулам, комплектующих не 4 а 70, параметров у каждого комплектующего по 20. Короче все настолько жутко медленно работает, что боишься что-то лишнее нажать, потому что обработка уходит в цикл. Пожалуйста, помогите, подскажите, может быть я выбрал не верную методику, может из-за того, что в столбце "А" формулы и при каждом движении формулы пересчитываются заставляя пробегать цикл скрытия строк по несколько раз? Очень жду Вашей помощи.
Использован код:
Код
Private Sub Worksheet_Calculate()
    Dim rngRows As Range
    Dim rngSrc As Range
    Dim arr()
     
    Application.EnableEvents = False
     
    PosStr = Cells.SpecialCells(xlCellTypeLastCell).Row
    Set rngSrc = Cells(1, 1).Resize(PosStr)
    rngSrc.EntireRow.Hidden = False
     
    arr = rngSrc.Value
        For r = 1 To PosStr
            If arr(r, 1) = 2 Then
                If Not rngRows Is Nothing Then
                    Set rngRows = Union(rngRows, Rows(r))
                Else
                    Set rngRows = Rows(r)
                End If 'Not rngRows Is Nothing
            End If 'arr(i, 1) = 2
        Next
     
    If Not rngRows Is Nothing Then rngRows.EntireRow.Hidden = True
     
    Application.EnableEvents = True
End Sub
 
 
 
#2
06.11.2018 17:23:32
bss17,у вас логика у вас так построена.
Учтите что ваш макрос будет срабативать, при каждом расчете
 
 
 
#3
06.11.2018 17:24:00
Убрал пока Application.ScreenUpdating = False, True. С ним данные в таблице не дергаются, но по времени выполнения особо ничего не меняется
 
 
 
#4
06.11.2018 17:27:19
ivanok_v2, с этим тоже проблема. По идее нужно только при изменении определенных значений (выборе комплектующих, изменении производительности, или типа). Но это можно в следующие улучшения, а вот то, что он на минуту вываливается при выполнении кода - это напрягает
 
 
 
#5
06.11.2018 17:39:18
а можно - без кодов, а простыми словами: пользователь делает это, в файле происходит следующее
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#6
06.11.2018 17:42:08
Цитата
bss17 написал:
определенных значений
используйте Worksheet_Change()
 
 
 
#7
06.11.2018 17:45:05
Ігор Гончаренко, можно попробовать. Пользователь выбирает тип производства и производительность из выпадающих списков, в зависимости от этого выводится доступные варианты комплектующих. Выбирая нужные комплектующие пользователь отмечает их галками, при выборе галкой комплектующих выводится список характеристик каждого из них. Если комплектующее не нужно, снимает галку, характеристики скрываются.
 
 
 
#8
06.11.2018 18:13:20
ivanok_v2, нужна помощь с адаптацией Worksheet_Change() к имеющемуся коду. Запускаем макрос при изменении значений в G30:G40
Пробовал переделать, но не выходит. Что не так:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngRows As Range
    Dim rngSrc As Range
    Dim arr()
     
    Application.EnableEvents = False
     
    If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("G30:G40")) Is Nothing Then
        PosStr = Cells.SpecialCells(xlCellTypeLastCell).Row
        Set rngSrc = Cells(1, 1).Resize(PosStr)
        rngSrc.EntireRow.Hidden = False
     
        arr = rngSrc.Value
         For r = 1 To PosStr
               If arr(r, 1) = 2 Then
                   If Not rngRows Is Nothing Then
                       Set rngRows = Union(rngRows, Rows(r))
                   Else
                        Set rngRows = Rows(r)
                    End If 'Not rngRows Is Nothing
               End If 'arr(i, 1) = 2
        Next
    End If
    End If
    If Not rngRows Is Nothing Then rngRows.EntireRow.Hidden = True
     
    Application.EnableEvents = True
End Sub
 
 
 
Страницы: 1
Наверх