Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
макрос скрытие/раскрытие по условию
 
#1
07.11.2014 20:58:23
Добрый день!
помогите пожалуйста исправить макрос, делает вот что:

на листе есть ячейки в которых при определённых условиях формулой пишется "скрыть".
Макрос перебирает все строки в рабочем диапазоне и проверяет их на скрытость:
Скрытый текст
макрос неправильно ищет (или не ищет вообще) в скрытых строках
заранее спасибо за помощь!
Код
Sub hide_unhide()
Dim ra As Range, unhidera As Range, hidera As Range
Application.ScreenUpdating = False

ТекстДляСкрытия = "скрыть"
For Each ra In ActiveSheet.UsedRange.Rows
'MsgBox ra.Row
If ra.EntireRow.Hidden = False Then 'если НЕскрыто, а "скрыть" ЕСТЬ
    If Not ra.Find(ТекстДляСкрытия, , xlValues, xlPart) Is Nothing Then
    If hidera Is Nothing Then Set hidera = ra Else Set hidera = Union(hidera, ra)
    End If
Else 'если СКРЫТО, а "скрыть" НЕТ
    If ra.Find(ТекстДляСкрытия, , LookIn:=xlFormulas) Is Nothing Then
        If unhidera Is Nothing Then Set unhidera = ra Else Set unhidera = Union(unhidera, ra)
    End If
End If
Next
If Not hidera Is Nothing Then hidera.EntireRow.Hidden = True
If Not unhidera Is Nothing Then unhidera.EntireRow.Hidden = False

Application.ScreenUpdating = True
ActiveSheet.Calculate

End Sub
Изменено: Максим - 08.11.2014 00:41:05
 
 
 
#2
07.11.2014 22:26:07
Заумно все как то. А проще нельзя?
Код
Sub hide_unhide1()
Application.ScreenUpdating = False
    ActiveSheet.Range("E1:E10").EntireRow.Hidden = False
    For i = 1 To 10
        If Cells(i, 4) = "скрыть" Then
            Cells(i, 4).EntireRow.Hidden = True
        End If
    Next
Application.ScreenUpdating = True
ActiveSheet.Calculate
End Sub
 
 
 
#3
07.11.2014 22:44:45
У меня этот макрос повешен на активацию листа. На листе очень много формул, факторы скрытия/раскрытия строк постоянно меняются. перераскрывать каждый раз все строки листа очень долго. Предложенный мной алгоритм (как мне кажется) должен работать значительно быстрее. Проблема одна - поиск "скрыть" в скрытой строке. Причем нужно чтобы поиск был по значениям ячеек, а не по тексту в них, т.к. При нахождении "скрыть" в условии формулы ячейки будет ошибочное срабатывание макроса.
Изменено: Максим - 07.11.2014 22:47:34
 
 
 
#4
08.11.2014 00:16:37
Цитата
перераскрывать каждый раз все строки листа очень долго
Тогда так.
Код
Sub hide_unhide1()
Application.ScreenUpdating = False
    For i = 1 To 10
        If Cells(i, 4) = "скрыть" Then Cells(i, 4).EntireRow.Hidden = True
        If Cells(i, 4) <> "скрыть" Then Cells(i, 4).EntireRow.Hidden = False
    Next
Application.ScreenUpdating = True
ActiveSheet.Calculate
End Sub
Цитата
Причем нужно чтобы поиск был по значениям ячеек, а не по тексту в них,
Немного не понятно, что в макросе не так?
 
 
 
#5
08.11.2014 01:17:16
gling, Максим правильно сказал, - если по одной строке скрывать / отображать, это очень медленно работает.
И отключении перерисовки экрана особо не помогает (ускоряет, но несильно)
Потому этот макрос сначала ищет все подходящие строки, а потом разом скрывает \ отображает их.


Максим, учтите, что Union может переполниться, если строк очень много. там какое-то ограничение на количество несмежных диапазонов, около 1000)
т.е. при количестве строк в таблице порядка 3-4 тыс, уже могут начаться проблемы

По вашему вопросу:
я бы сделал отдельную функцию для поиска, в которой считывал бы строку в массив, и в массиве перебором бы искал нужное значение

примерно так: (в Usedrange должно быть БОЛЕЕ одного столбца - минимум два)
Код
Function check(ByRef ra As Range) As Boolean
    On Error Resume Next: arr = ra.Value
    For i = LBound(arr, 2) To UBound(arr, 2)
        If arr(1, i) = "скрыть" Then check = True: Exit Function
    Next i
End Function
и потом бы заменил строку
Код
If Not ra.Find(ТекстДляСкрытия, , xlValues, xlPart) Is Nothing Then
на
Код
If check(ra) Then
Изменено: Игорь - 08.11.2014 01:17:44
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#6
08.11.2014 01:41:53
Доброй ночи
А нельзя в цикле в строковую переменную a записать номера нужных строк ("2:2,4:4,6:6")
Затем скрыть их:
Код
Range(a).EntireRow.Hidden = True

Или здесь тоже есть ограничения?
 
 
 
#7
08.11.2014 02:01:52
Цитата
Игорь пишет: около 1000
точнее - 8192
для Excel 2013 неактуально
Цитата
Alexander88 пишет:Или здесь тоже есть ограничения?
а потестировать?  :)
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#8
08.11.2014 02:52:56
Протестировал - получилось скрыть 45 строк, дальше ошибка
Ограничение длинны строки: 255 символов (тут об этом написано)
Видимо альтернативы Union по скорости нет
Простите за офф
 
 
 
#9
08.11.2014 05:50:19
Максим, Расширенный фильтр и немного магии смотрели?

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#10
08.11.2014 08:27:43
Так будет быстро:
Код
Sub qq()
    Dim i As Long: Application.ScreenUpdating = False
    If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
    Rows(1).Insert: [D1] = "qq": i = Cells(Rows.Count, "D").End(xlUp).Row
    Cells(i + 2, 4) = "qq": Cells(i + 3, 4) = "<>скрыть"
    Range("D1:D" & i).AdvancedFilter xlFilterInPlace, Cells(i + 2, 4).Resize(2)
    Cells(i + 2, 4).Resize(2).ClearContents: Rows(1).Delete
End Sub

Для того, чтобы Ваша кнопка не скрывалась вместе с ячейками рабочего листа, установите в свойствах объекта "не перемещать и не изменять размеры".
Чем шире угол зрения, тем он тупее.
 
 
 
#11
08.11.2014 09:13:51
А так тоже долго?
Код
Sub скрыть()
    ActiveSheet.Range("$A$1:$E$9").AutoFilter Field:=4, Criteria1:="скрыть"
End Sub
Строку с фильтром можно скрыть.
 
 
 
#12
09.11.2014 02:10:50
спасибо всем за отклики!
Цитата
gling пишет: Немного не понятно, что в макросе не так?
в предложенном Вами макросе всё работает применительно к примеру. Я возможно не совсем правильно объяснил в своём втором посте, и что потом пояснил Игорь, - поочерёдное скрытие/раскрытие происходит очень долго применительно к листу с сотнями или тысячами строк, к тому же перегруженных формулами.
Цитата
JayBhagavan пишет:  Расширенный фильтр и немного магии смотрели?
спасибо за ссылку посмотрю обязательно, возможно его действительно можно применить в моём случае

SAS888, Ваш вариант работает корректно,но он, если я правильно понял, совсем заточен под мой пример. В желаемом мной макросе не должно быть привязок к конкретным ячейкам и диапазонам - только рабочий диапазон. Мне не хватило знаний переделать его под ActiveSheet.UsedRange. И ещё если повесить его на событие Worksheet_Change, то эксель намертво вешается.
Цитата
gling пишет: А так... Строку с фильтром можно скрыть.
предложенный вами макрос у меня работает не корректно. Вообще я допускаю что возможно решение моего вопроса с помощью фильтров (или расширенных фильтров), но я как-то уж решил идти по пути скрытия по условию и не хочу бросать этот вариант на полпути, но обещаю поразбираться с таким вариантом решения  :)  

Игорь, Ваш вариант мне полностью подошёл! Действительно представленный мной макрос вырос из того на который вы сослались и я долгое время пользовался именно им, но сейчас мне подумалось что для моих целей его можно было бы оптимизировать.
С Вашей помощью вышло вот что:
Код
Sub hide_unhide()
Dim ra As Range, unhidera As Range, hidera As Range
Application.ScreenUpdating = False
ТекстДляСкрытия = "скрыть"
For Each ra In ActiveSheet.UsedRange.Rows
If check(ra) Then 'если "скрыть" нашлось и строка РАСкрыта
    If ra.EntireRow.Hidden = False Then If hidera Is Nothing Then Set hidera = ra Else Set hidera = Union(hidera, ra)
Else 'если "скрыть" не нашлось и строка скрыта
    If ra.EntireRow.Hidden = True Then If unhidera Is Nothing Then Set unhidera = ra Else Set unhidera = Union(unhidera, ra)
End If
Next
If Not hidera Is Nothing Then hidera.EntireRow.Hidden = True
If Not unhidera Is Nothing Then unhidera.EntireRow.Hidden = False
Application.ScreenUpdating = True
End Sub

Function check(ByRef ra As Range) As Boolean
    On Error Resume Next: arr = ra.Value
    For i = LBound(arr, 2) To UBound(arr, 2)
        If arr(1, i) = "скрыть" Then check = True: Exit Function
    Next i
End Function
нашёл ошибку - при наличии в ячейке ошибки, отрабатывает строку "под скрытие".
вроде исправил, но чувствую что как-то тупо...
Код
Function check(ByRef ra As Range) As Boolean
arr = ra.Value
For i = LBound(arr, 2) To UBound(arr, 2)
    If IsError(arr(1, i)) Then GoTo дальше
    If arr(1, i) = "скрыть" Then check = True: Exit Function
дальше:
Next i
End Function
Изменено: Максим - 09.11.2014 10:21:14
 
 
 
Страницы: 1
Читают тему
Наверх