Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel

Сообщение успешно добавлено.

Страницы: 1
RSS
Скрытие/отображение ненужных строк и столбцов, Правильная работа функции ЕСЛИ
 
#1
11.10.2022 13:35:02
Всем привет!
Столкнулся с маленькой проблемкой.
Так, согласно статьи https://www.planetaexcel.ru/techniques/9/121/  (способ № 3) в "умной таблице" при помощи функции:
Код
=ЕСЛИ(C5=0;ЕСЛИ(L5<=0;"х";0);0)

в столбце 15 таблицы постарался отметить строки, которые с помощь макроса мне нужно скрывать, но:
Например, если значение в ячейке L14=0, то мне необходимо чтобы "х" проставлялся также и ячейке L10 и т.д. (в примере заливка красным цветом).
Формулу крутил и так и эдак, но ничего не получается.
На выходе, при срабатывании макроса у меня должны остаться только строки, которые содержат:
1. Наименование материалов (А)
2. Остаток материалов (L).
На листе 2 постарался показать результат.
Спасибо.
Изменено: graffserg - 11.10.2022 13:35:31
 
 
 
#2
11.10.2022 13:52:45
Код
Sub СкрытьБелых()
    If ActiveSheet.ListObjects.Count = 0 Then Exit Sub
    
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.EntireRow.Hidden = False
    Dim tb As ListObject
    For Each tb In ActiveSheet.ListObjects
        JobTb tb
    Next
    Application.ScreenUpdating = True
End Sub
Private Sub JobTb(tb As ListObject)
    Dim cl As Range
    For Each cl In tb.DataBodyRange.Columns(1).Cells
        Select Case cl.Interior.Color
        Case 11389944, 14277081
        Case Else
            cl.EntireRow.Hidden = True
        End Select
    Next
End Sub
 
 
 
#3
11.10.2022 13:59:33
Цитата
написал:
если значение в ячейке L14=0, то мне необходимо чтобы "х" проставлялся также и ячейке L10 и т.д.
В ячейку L5
Код
=ЕСЛИ(ИНДЕКС(L6:$L$65;ПОИСКПОЗ("ИТОГО:";B6:$B$65;0))=0;"х";"")
 
 
 
#4
11.10.2022 14:08:09
МатросНаЗебре добрый день и спасибо за отклик.
Макрос работает, но ячейки в столбце L, которые имеют 0 значение остались, как и строки с наименованием материалов, которые связаны с итоговыми значениями в столбце L.
На листе 2 я постарался показать итоговый вариант таблицы. Макрос планируется привязать к кнопке, с помощью которой оператор будет скрывать или отображать строки.
Спасибо.
 
 
 
#5
11.10.2022 14:16:46
В таком варианте скрывает, если в столбце 15 х.
Код
Sub СкрытьБелыхИ_х()
    If ActiveSheet.ListObjects.Count = 0 Then Exit Sub
    
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.EntireRow.Hidden = False
    Dim tb As ListObject
    For Each tb In ActiveSheet.ListObjects
        JobTb tb
    Next
    Application.ScreenUpdating = True
End Sub
Private Sub JobTb(tb As ListObject)
    Dim flag As Boolean
    Dim cl As Range
    For Each cl In tb.DataBodyRange.Columns(1).Cells
        flag = False
        If cl.Cells(1, 15).Value = "х" Then
            flag = True
        End If
        Select Case cl.Interior.Color
        Case 11389944, 14277081
        Case Else
            flag = True
        End Select
        
        If flag Then cl.EntireRow.Hidden = True
    Next
End Sub
 
 
 
#6
11.10.2022 14:23:58
Спасибо! Все работает.
 
 
 
#7
05.03.2023 15:13:43
Всем привет!
Подскажите пожалуйста решение - как можно ускорить работу макроса.
В процессе работы с файлом количество строк в "умной таблице" достигло более 3 500 тыс. строк. И макрос стал очень долго обрабатывать скрытие строк - более 5 минут.
Файл не выкладываю, т.к. его объем велик, а если прикрепить урезанный вариант, то скорость работы макроса сложно будет оценить.
Спасибо.
Изменено: graffserg - 05.03.2023 15:14:16
 
 
 
#8
05.03.2023 15:16:36
О кроссах нужно сообщать
 
 
 
#9
05.03.2023 15:27:05
Извините, не успел.
Кросс
 
 
 
#10
04.04.2023 19:13:33
Всем привет!
Вопрос по теме еще в актуальном состоянии!!
Подскажите, может быть есть решение?
 
 
 
#11
05.04.2023 10:18:11
Можно вместо получения значения ячейки получать значение из массива. Какая-то оптимизация будет, однако, остаётся обращение к ячейке для получения цвета.
Код
Sub СкрытьБелыхИ_хarr()
    If ActiveSheet.ListObjects.Count = 0 Then Exit Sub
     
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.EntireRow.Hidden = False
    Dim tb As ListObject
    For Each tb In ActiveSheet.ListObjects
        JobTb tb
    Next
    Application.ScreenUpdating = True
End Sub
Private Sub JobTb(tb As ListObject)
    Dim flag As Boolean
    Dim cl As Range
    Dim yy As Long
    Dim arr As Variant
    arr = tb.DataBodyRange.Columns(15).Value
    
    'For Each cl In tb.DataBodyRange.Columns(1).Cells
    For yy = 1 To UBound(arr, 1)
        flag = False
        'If cl.Cells(1, 15).Value = "х" Then
        If arr(yy, 1) = "х" Then
            flag = True
        End If
        Set cl = tb.DataBodyRange.Cells(yy, 1)
        Select Case cl.Interior.Color
        Case 11389944, 14277081
        Case Else
            flag = True
        End Select
         
        If flag Then cl.EntireRow.Hidden = True
    Next
End Sub
 
 
 
#12
05.04.2023 20:50:19
МатросНаЗебре спасибо за помощь!!
Попробовал, но скорость не сильно возросла.
Код
Sub СкрытьБелыхИ_х()

Dim с As Date
Dim d As Single
'Больше не обновляем страницы после каждого действия
Application.ScreenUpdating = False
'Отключаем события
Application.EnableEvents = False
'Расчёты переводим в ручной режим
Application.Calculation = xlCalculationManual
c = Time
    If ActiveSheet.ListObjects.Count = 0 Then Exit Sub
    
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.EntireRow.Hidden = False
    Dim tb As ListObject
    For Each tb In ActiveSheet.ListObjects
        JobTb tb
    Next
    Application.ScreenUpdating = True
    d = (Time - c) * 24 * 60 * 60
'Расчёты переводим в автоматический режим
Application.Calculation = xlCalculationAutomatic
'Включаем события
Application.EnableEvents = True
'Включаем обновление страниц после каждого действия
Application.ScreenUpdating = True

    MsgBox "Время выполения макроса составило: " & d & " c.", vbInformation, "Отчет"
End Sub
Private Sub JobTb(tb As ListObject)
    Dim flag As Boolean
    Dim cl As Range
    For Each cl In tb.DataBodyRange.Columns(1).Cells
        flag = False
        If cl.Cells(1, 14).Value = "х" Then
            flag = True
        End If
        Select Case cl.Interior.Color
        Case 11389944, 14277081
        Case Else
            flag = True
        End Select
        
        If flag Then cl.EntireRow.Hidden = True
    Next
End Sub


Вот результаты:
число строк 3616:
- время выполнения доработанного макроса 3 с.
- время выполнения без доработки Excel после 5 минут обработки не отвечает :'( %)
И ВОТ РЕЗУЛЬТАТ - 85757 с

Но вот еще что меня волнует:
1. Как привязать макрос на работу в с "умной таблицей"?
2. Возможно ли сделать так, чтобы столбец, в котором имеется значение "скрыть" был постоянно скрыт от глаз пользователя?
3. Возможно ли сделать так, чтобы строки 5-9 были постоянно скрыты от глаз пользователя?

Буду признателен за оказанную помощь.
 
 
 
#13
05.04.2023 21:46:48
graffserg, Здравствуйте. А вы видите разницу своего кода что вы выложили постом выше моего и кодом что выложил МатросНаЗебре в сво5ём посте #11? Как вы думаете, он зря закоментиривал несколько строк? Или вам без разницы какая оптимизация?
Изменено: MikeVol - 05.04.2023 21:52:30
 
 
 
#14
05.04.2023 23:01:44
Уважаемый MikeVol добрый день/вечер!
Насчет Вашего сообщения - я не хочу и не хотел никого обидеть или упрекнуть.
Цитата
MikeVol написал:
А вы видите разницу своего кода
конечно вижу, как минимум во второй части кода, но я не так силен в vba чтобы код разложить по полочкам. И мне совсем не без разницы какая оптимизация, так как тему я поднял с целью ускорения макроса.

На данный момент еще раз тестирую макрос предоставленный уважаемым МатросНаЗебре. Постараюсь более детально разобраться.

Вот код:
Код
Sub СкрытьБелыхИ_хarr()
Dim с As Date
Dim d As Single
'Больше не обновляем страницы после каждого действия
'Application.ScreenUpdating = False
'Отключаем события
'Application.EnableEvents = False
'Расчёты переводим в ручной режим
'Application.Calculation = xlCalculationManual
c = Time
    If ActiveSheet.ListObjects.Count = 0 Then Exit Sub
      
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.EntireRow.Hidden = False
    Dim tb As ListObject
    For Each tb In ActiveSheet.ListObjects
        JobTb tb
    Next
    Application.ScreenUpdating = True
        d = (Time - c) * 24 * 60 * 60
'Расчёты переводим в автоматический режим
'Application.Calculation = xlCalculationAutomatic
'Включаем события
'Application.EnableEvents = True
'Включаем обновление страниц после каждого действия
'Application.ScreenUpdating = True
 
    MsgBox "Время выполнения макроса составило: " & d & " c.", vbInformation, "Отчет"
End Sub
Private Sub JobTb(tb As ListObject)
    Dim flag As Boolean
    Dim cl As Range
    Dim yy As Long
    Dim arr As Variant
    arr = tb.DataBodyRange.Columns(14).Value
     
    'For Each cl In tb.DataBodyRange.Columns(1).Cells
    For yy = 1 To UBound(arr, 1)
        flag = False
        'If cl.Cells(1, 15).Value = "х" Then
        If arr(yy, 1) = "х" Then
            flag = True
        End If
        Set cl = tb.DataBodyRange.Cells(yy, 1)
        Select Case cl.Interior.Color
        Case 11389944, 14277081
        Case Else
            flag = True
        End Select
          
        If flag Then cl.EntireRow.Hidden = True
    Next
End Sub

Затраченное время 10 мин. 29 сек. при количестве строк 3445

С заменой строк:
Код
    For Each cl In tb.DataBodyRange.Columns(1).Cells
    'For yy = 1 To UBound(arr, 1)
        flag = False
        If cl.Cells(1, 14).Value = "х" Then
        'If arr(yy, 1) = "х" Then

Затраченное время 05 мин. 11 сек. при количестве строк 3445
Изменено: graffserg - 05.04.2023 23:50:06
 
 
 
#15
06.04.2023 00:05:32
graffserg, Страно конечно. С массивами должно было быть быстрее.
 
 
 
#16
06.04.2023 00:34:01
Цитата
graffserg написал:
Но вот еще что меня волнует:
2. Возможно ли сделать так, чтобы столбец, в котором имеется значение "скрыть" был постоянно скрыт от глаз пользователя?
3. Возможно ли сделать так, чтобы строки 5-9 были постоянно скрыты от глаз пользователя?

Вот добавил макрос в корень "Эта книга":
Код
Sub HideColumnsRows()
   With Worksheets("Литс 1")
      .Columns(14).Hidden = True
      .Rows("5:9").Hidden = True
   End With
End Sub


Вроде все стартует. Но не могу понять, как сделать так, чтобы он реагировал на автоматическое скрытие даже тогда, когда пользователь их "покажет".
Изменено: graffserg - 06.04.2023 00:36:23
 
 
 
#17
06.04.2023 00:53:11
тема скрытия столбцов и строк - неисчерпаема))
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#18
06.04.2023 01:26:56
graffserg, А если так?
Код
Private Sub Workbook_Open()

       With Worksheets("Литс 1")
          .Columns(14).Hidden = True
          .Rows("5:9").Hidden = True
          .EnableSelection = xlNoSelection
       End With

End Sub
Изменено: MikeVol - 06.04.2023 02:04:34 (Исправил название листа на Литс как у ТС)
 
 
 
#19
06.04.2023 01:29:45
Судя по сообщению #16, у ТС лист называется "Литс 1", а не "Лист 1", поэтому код может не заработать  
Изменено: New - 06.04.2023 01:31:00
 
 
 
#20
06.04.2023 02:05:49
New, Здравствуйте. Исправил выше, пардон. Спасибо что заметили.
 
 
 
#21
06.04.2023 10:48:04
Цитата
New написал:
Судя по сообщению #16, у ТС лист называется "Литс 1", а не "Лист 1", поэтому код может не заработать  
Ребята, все нормально - это файл примера и я там не заметил опечатку. Код работает.
Спасибо.
 
 
 
Страницы: 1

Сообщение успешно добавлено.

Наверх