Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Скрыть (или удалить) строки с нулевым значением
 
#1
28.08.2014 11:49:33
Здравствуйте! Нашел макрос  который скрывает  строки.
Макрос скрывает  те строки в которых пустые ячейки в столбце F.
Уважаемые подскажите что нужно сделать что бы макрос работал не по условию пустых ячеек а по условию нулевого  значения в ячейках.
Код
Dim cell As Range: Application.ScreenUpdating = False
For Each cell In [F2:F25].Cells
If cell.Find("*", , xlValues, xlPart) Is Nothing Then
cell.EntireRow.Hidden = True
End If
Next cell
 
 
 
#2
28.08.2014 11:55:50
Используйте макрорекордер. (например, найти в диапазоне ячейку целиком с нулём)

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#3
28.08.2014 11:57:33
?
Код
..............................
If cell.Value = 0 Then 
..............................
Согласие есть продукт при полном непротивлении сторон
 
 
 
#4
28.08.2014 12:12:07
Правда говоря я в excel  новичок. Если вас не затруднит не могли бы выложить полную версию переделанного кода для моего случая.
 
 
 
#5
28.08.2014 12:14:14
.
Код
Dim cell As Range: Application.ScreenUpdating = False
For Each cell In [F2:F25].Cells
   If cell.Value = 0 Then cell.EntireRow.Hidden = True
Next cell
Согласие есть продукт при полном непротивлении сторон
 
 
 
#6
28.08.2014 12:16:45
Код
Dim cell As Range: Application.ScreenUpdating = False
For Each cell In [F2:F25]
If cell.Value = 0 Then
cell.EntireRow.Hidden = True
End If
Next cell
п.с. пустые тоже спрячет.
Изменено: V - 28.08.2014 12:20:00
 
 
 
#7
28.08.2014 12:19:53
Можно сделать и вовсе не используя циклы. Например так:
Код
Sub Main()
    Dim x As Range
    Set x = GetRange([F2:F25], 0)
    If Not x Is Nothing Then x.EntireRow.Hidden = True
End Sub

Function GetRange(rng As Range, Item As String) As Range
    rng.Replace "", "/\", xlWhole: rng.Replace Item, "", xlWhole
    On Error Resume Next: Set GetRange = rng.SpecialCells(xlCellTypeBlanks): On Error GoTo 0
    rng.Replace "", Item, xlWhole: rng.Replace "/\", "", xlWhole
End Function

Функция "GetRange" получает 2 аргумента: диапазон и значение. Возвращает диапазон ячеек, содержащий данное значение.
Изменено: SAS888 - 28.08.2014 12:21:24
Чем шире угол зрения, тем он тупее.
 
 
 
#8
28.08.2014 12:23:19
Цитата
dx48 пишет: Правда говоря я в excel новичок
Не правда. Обычный халявщик.

PS И не надо слать подобные ЛС. От этого вы не перестанете быть халявщиком.
Изменено: RAN - 28.08.2014 23:17:43
 
 
 
#9
28.08.2014 19:09:36
Цитата
V пишет: п.с. пустые тоже спрячет.
Подскажите а как сделать так что бы пустые не скрывало?
 
 
 
#10
28.08.2014 19:21:24
Sanja, Ваш код тоже скрывает пустые строки а нужно только с нулевым значением  
 
 
 
#11
28.08.2014 19:28:10
Или добавить проверку на "не пусто" или попробовать вот так:
Код
If cell.Value = "0" Then
 
 
 
#12
28.08.2014 19:50:37
В ответе V эта строка прописана только его код скрывает пустые ячейки тоже а мне надо что бы скрывало только с значением с ноль.
 
 
 
#13
28.08.2014 19:51:48
Цитата
dx48 пишет: В ответе V эта строка прописана
Сравните его строку и мою...
 
 
 
#14
28.08.2014 20:09:59
Юрий М, Спасибо выручили!  
 
 
 
#15
05.10.2014 20:51:09
Уважаемые знатоки, прошу вас совета и помощи, у меня имеется большой файл более 59 тысяч строк, с помощью поиска я отыскал макрос который скрывает нулевые значения, однако этот процесс очень медленно происходит. Есть ли возможность как то ускорить данный процесс
Код
Public Sub Delete_Row()
 
 Dim DR As Range, LastRow As Long, r As Long
 On Error Resume Next
 Set DR = Application.InputBox("Выделите диапазон, в котором необходимо удалить строки с нулевым значением:", _
"Выделите диапазон", Default:=ActiveCell.Address, Type:=8
 On Error GoTo 0
 If DR Is Nothing Then
     Exit Sub
 Else
     LastRow = DR.Rows.Count
     LastRow = LastRow + DR.Row - 1
     Application.ScreenUpdating = False
     For r = LastRow To DR.Row Step -1
        If Cells(r, DR.Column).Value = 0 Then Rows(r).Hidden = True       
     Next r
  End If
 
End Sub
Изменено: Алексей Волков - 05.10.2014 20:57:49
 
 
 
#16
05.10.2014 21:05:48
Поищите темы, где упоминается фрагмент код, содержащий delra - в них будет разговор о том, что можно сначала собрать номера строк, которые нужно скрыть, в массив, а потом уже этот массив удалять одним махом. Поменяете удаление на скрытие - вот и получите заметное ускорение)
 
 
 
#17
05.10.2014 21:35:46
спасибо за наводку нашел макрос начал его корректировать под числовое значение но видимо не до конца понял как это правильно сделать - укажите на ошибки пож-ста (заменить текст на числовое значение. думал за аналогию взять вышеуказанный макрос
Код
Sub СкрытиеСтрокПоУсловию() 
Dim DR As Range, LastRow As Long, r As Long 
Dim ra As Range, delra As Range, ТекстДляПоиска As String 
Application.ScreenUpdating = False ' отключаем обновление экрана 

ТекстДляПоиска = "Наименование ценности" ' скрываем строки с таким текстом 

' перебираем все строки в используемом диапазоне листа 
For Each ra In ActiveSheet.UsedRange.Rows 
' если в строке найден искомый текст 
If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) IsNothing Then 
' добавляем строку в диапазон для скрытия 
If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra) 
End If 
Next 
' если подходящие строки найдены - скрываем их 
If Not delra Is Nothing Then delra.EntireRow.Hidden=TRUE 
End Sub


Исправил, спасибо за замечание,  
Изменено: Алексей Волков - 05.10.2014 21:41:31
 
 
 
#18
05.10.2014 21:38:04
Вы видели, как другие оформляют код? Для этого есть специальный тег - кнопка <...>. Исправляйте.
 
 
 
#19
05.10.2014 21:56:22
Спасибо за замечание - исправил - на будущее учту
 
 
 
#20
05.10.2014 22:01:14
В каком столбце будете искать ноль?
 
 
 
#21
05.10.2014 22:04:18
в столбце "I"
 
 
 
#22
05.10.2014 22:08:46
Код
Sub СкрытиеСтрокПоУсловию()
Dim LastRow As Long, r As Long
Dim ra As Range, delra As Range
    Application.ScreenUpdating = False ' отключаем обновление экрана
    LastRow = Cells(Rows.Count, 9).End(xlUp).Row 'нашли последнюю строку по столбцу I
    ' перебираем все ячейки в столбце I
    For Each ra In Range(Cells(2, 9), Cells(LastRow, 9))
        ' если в ячейке ноль, то
        If ra = 0 Then
            ' добавляем строку в диапазон для скрытия
            If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
    Next
    ' если подходящие строки найдены - скрываем их
    If Not delra Is Nothing Then delra.EntireRow.Hidden = True
End Sub
 
 
 
#23
05.10.2014 22:15:31
Благодарю за оказанное содействие
 
 
 
#24
06.10.2014 06:46:51
Рекомендую использовать расширенный фильтр, который работает мгновенно.
Для конкретной задачи это примерно так:
Код
Sub Main()
    Dim i As Long, x As Range: Application.ScreenUpdating = False
    i = Cells(Rows.Count, "I").End(xlUp).Row: Set x = Range("I1:I" & i)
    Cells(i + 2, "I") = [I1]: Cells(i + 3, "I") = "<>0"
    x.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Cells(i + 2, "I").Resize(2), Unique:=False
    Cells(i + 2, "I").Resize(2).ClearContents
End Sub

Для того, чтобы отобразить скрытые фильтром строки, нужно использовать
Код
ActiveSheet.ShowAllData
ПРИМЕЧАНИЕ: Ячейка "I1" должна содержать какое-либо значение (заголовок). Если это не так, то диапазон фильтрации нужно изменить на требуемый.
Изменено: SAS888 - 06.10.2014 08:27:09
Чем шире угол зрения, тем он тупее.
 
 
 
#25
04.08.2015 17:22:26
Добрый день!
Я использую такой макрос в прайсе, чтоб убрать незаполненные строки
Код
Sub отфильтровать()
Dim cell As Range: Application.ScreenUpdating = False
For Each cell In [D8:D1089].Cells
If cell.Find("*", , xlValues, xlPart) Is Nothing Then
cell.EntireRow.Hidden = True
End If
Next cell
End Sub

Но после того как отфильтрую, больше изменения внести не могу, если забыла что-то...
Как можно опять отобразить скрытые строки ??? Все перерыла не могу найти((( Помогите пожалуйста
 
 
 
#26
04.08.2015 21:58:47
Цитата
gyuntner написал: Как можно опять отобразить скрытые строки ???
Вариант:
Код
Sub ShowHidden()
    With [D8:D1089].Cells
        .EntireRow.Hidden = False
    End With
End Sub
 
 
 
#27
05.08.2015 15:30:53
Спасибо, Юрий!!!!!:)
 
 
 
Страницы: 1
Читают тему
Наверх