Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Скрыть отобразить строки
 
#1
17.10.2017 01:30:00
Доброго времени Уважаемые Форумчане. Прошу подсказать как одной кнопкой заменить две, т.е в нажатом состоянии срабатывает макрос скрыть, в отжатом отобразить. Заранее благодарен
Код
Application.DisplayAlerts = False
Dim LastRow, ST_A() As Variant
Dim ii As Integer
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
ReDim ST_A(LastRow, 1)
ST_A = Range(Cells(1, 1), Cells(1 + LastRow - 1, 1))

For ii = 1 To LastRow
    If ST_A(ii, 1) = 0 Or ST_A(ii, 1) = "" Then
       Rows(ii).Hidden = True
    End If
Next

MsgBox "ГОТОВО"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub Открыть()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Dim LastRow, ST_A() As Variant
'Dim ii As Integer
'LastRow = Cells(Rows.Count, 1).End(xlUp).Row
'ReDim ST_A(LastRow, 1)
'ST_A = Range(Cells(1, 1), Cells(1 + LastRow - 1, 1))

'For ii = 1 To LastRow
    'If ST_A(ii, 1) = 0 Or ST_A(ii, 1) = "" Then
       'Rows(ii).Hidden = False
    'End If
'Next
    Cells.Select
    Selection.EntireRow.Hidden = False

MsgBox "ГОТОВО"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
 
 
 
#2
17.10.2017 01:39:26
alex1210, Как вариант: добавить кнопочку из элементов ActiveX и повесить примерно такую процедуру
Код
Private Sub CommandButton1_Click()
If CommandButton1.Caption = "Скрыть" Then
    CommandButton1.Caption = "Отобразить"
    Call Скрыть
Else
    CommandButton1.Caption = "Скрыть"
    Call Открыть
End If
End Sub
Изменено: Александр П. - 17.10.2017 01:40:54
 
 
 
#3
17.10.2017 01:49:24
Александр П., Доброго времени, что то у меня не получается. Там Выскакивает msgbox когда я нажимаю на ОК оно обратно отменяет первую процедуру
 
 
 
#4
17.10.2017 01:54:16
alex1210, Это в приложенном мной примере ?) Я чего т такого не замечаю )
 
 
 
#5
17.10.2017 02:00:06
alex1210, у Вас куча ошибок.
Cells(Rows.Count, 1).End(xlUp).Row - последние скрытые строки не попадут в диапазон.
Application.DisplayAlerts отключать не нужно, код не вызывает системные сообщения.
ReDim ST_A(LastRow, 1) не нужно, следующей строкой Вы перекраиваете массив.
ST_A(ii, 1) = "" - пустой элемент массива - Empty

Примерно так (не проверял)
Код
Sub VisibleRows()
Dim LastRow, ST_A()
Dim ii As Integer
    Application.ScreenUpdating = False
    LastRow = ActiveSheet.UsedRange.Rows.Count
    Rows("1:" & LastRow).Hidden = False ' показываем все
    
    With CommandButton1
        If .Caption = "Отобразить" Then
            .Caption = "Скрыть"
        Else
            .Caption = "Отобразить"
            ST_A = Range("A1:A" & LastRow)
 
            For ii = 1 To LastRow
                If ST_A(ii, 1) = 0 Or ST_A(ii, 1) = Empty Then Rows(ii).Hidden = True
            Next ii
        End If
    End With

    Application.ScreenUpdating = True
    MsgBox "ГОТОВО", 64, ""
End Sub
 
 
 
#6
17.10.2017 02:14:45
vikttur, подскажите, мне убрать свой старый код и код  Александра П и туда же прописать Ваш
 
 
 
#7
17.10.2017 02:19:44
Переведите процедуру на запуск кнопкой:
Код
Private Sub CommandButton1_Click()

и поместите код в модуль листа.

Можно без применения элементов ActiveX: код разместить в общем модуле, вместо CommandButton1.Caption менять значение ячейки.
 
 
 
#8
17.10.2017 02:21:27
vikttur,Беда, ругается на строку call скрыть. Заменил скрыть на VisibleRows не работает
 
 
 
#9
17.10.2017 02:27:44
Цитата
alex1210 написал: ругается на строку call скрыть
Где Вы нашли такую строку? Никакие дополнительные макросы не нужны.
 
 
 
#10
17.10.2017 02:29:03
vikttur, Я чего то видимо нахреначил , помотрите пожалуйста, что то у меня совсем не так)))
В модуль прописываю Ваш код. Всё остальное удаляю, а как мне АктивХ прицепить к коду. Не получается(((
 
 
 
#11
17.10.2017 02:36:47
alex1210,Что ж вы так ))), для начала нужно было удалить все лишнее. Поместил переработанный vikttur-ом код, удалил все остальное.
Изменено: Александр П. - 17.10.2017 02:37:03
 
 
 
#12
17.10.2017 02:42:36
УРАААААА Работает. Подскажите, когда я нажимаю на кнопке остается выделение я скидываю его "esc". А можно что нибудь придумать чтоб это выделение само сбрасывалось?
 
 
 
#13
17.10.2017 02:51:31
Пример
 
 
 
#14
17.10.2017 03:04:57
vikttur, Спасибо большое)))) Это же кнопка не АктивХ? и работает как переключатель. А как у нее это получается. извините что Вас отвлекаю, просто у меня как минимум 6 листов будет. и я хочу научиться как это делается
 
 
 
#15
17.10.2017 03:11:38
Научился))))))Работает!!!!! Спасибо ещё раз))))
 
 
 
#16
17.10.2017 03:58:30
vikttur, подскажите что надо в коде изменить если надо контролировать диапазон D10:D64
 
 
 
#17
17.10.2017 04:50:07
del
Изменено: Александр П. - 18.10.2017 01:41:22
 
 
 
#18
17.10.2017 19:44:40
Александр П., vikttur, Доброго времени, посмотрите пожалуйста, выскакивает ошибка. Настраиваю код по 6 столбцу
Код
Sub start()
Dim LastRow, ST_A()
Dim ii As Integer
    Application.ScreenUpdating = False
    LastRow = ActiveSheet.UsedRange.Rows.Count
    Rows("1:" & LastRow).Hidden = False ' показываем все
     
    With ActiveSheet.Shapes.Range(Array("пуск")). _
                    TextFrame2.TextRange.Characters
        If .Text = "Отобразить" Then
            .Text = "Скрыть"
        Else
            .Text = "Отобразить"
            ST_A = Range("F1:F" & LastRow)
  
            For ii = 10 To 64
            
                If ST_A(ii, 6) = 0 Or ST_A(ii, 6) = Empty Then Rows(ii).Hidden = True
            Next ii
        End If
    End With
 
    Application.ScreenUpdating = True
    MsgBox "ГОТОВО", 64, ""
End Sub
 
 
 
#19
17.10.2017 23:59:33
Разобрался. код
Код
If ST_A(ii, 1) = 0 Or ST_A(ii, 1) = Empty Then Rows(ii).Hidden = True
тут ничего менять не надо было. И получилось для того чтобы код отслеживал диапазон 10:64 по столбцу F нужно прописать код в лист
Код
Sub start()
Dim LastRow, ST_A()
Dim ii As Integer
    Application.ScreenUpdating = False
    LastRow = ActiveSheet.UsedRange.Rows.Count
    Rows("1:" & LastRow).Hidden = False 'показывать всё
     
    With ActiveSheet.Shapes.Range(Array("пуск")). _
                    TextFrame2.TextRange.Characters
        If .Text = "Отобразить" Then
            .Text = "Скрыть"
        Else
            .Text = "Отобразить"
            ST_A = Range("F1:F" & LastRow)
  
            For ii = 10 To 64
            
                If ST_A(ii, 1) = 0 Or ST_A(ii, 1) = Empty Then Rows(ii).Hidden = True
           Next ii
        End If
    End With
 
    Application.ScreenUpdating = True
    MsgBox "Готово, 64, ""
End Sub

Александр П., vikttur, спасибо. код очень пригодится

Изменено: alex1210 - 18.10.2017 00:02:16
 
 
 
Страницы: 1
Наверх