Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Удаление строк в листе по содержимому столбца G
 
#1
28.03.2015 19:55:31
Добрый вечер уважаемые форумчане!
Хочу макросом удалить содержимое строк.
Есть у меня макрос, который по фиксированному значению текста удаляет строки:
Код
    Dim ra As Range, delra As Range
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ' ищем и удаляем строки, содержащие заданный текст
   ' (можно указать сколько угодно значений, и использовать подстановочные знаки)
   УдалятьСтрокиСТекстом = Array("ID ", "Шапка ", "Лицензия ", "(СЗ")

    ' перебираем все строки в используемом диапазоне листа
   For Each ra In ActiveSheet.UsedRange.Rows
        ' перебираем все фразы в массиве
       For Each word In УдалятьСтрокиСТекстом
            ' если в очередной строке листа найден искомый текст
           If Not ra.Find(word, , xlValues, xlPart) Is Nothing Then
                ' добавляем строку в диапазон для удаления
               If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
            End If
        Next word
    Next

    ' если подходящие строки найдены, то: (оставьте одну из 2 следующих строк)
   If Not delra Is Nothing Then delra.EntireRow.Hidden = True    ' скрываем их
   If Not delra Is Nothing Then delra.EntireRow.Delete    ' удаляем их
Не могу им пользоваться, т.к. признак текста по которому происходит удаление строк заранее неизвестен и может меняться.
Поэтому в столбце G я добавляю строки с текстом, который хочу удалить. Если такие строки присутствуют в столбце G, их нужно стереть на всем листе.
Файл прилагаю вложением для наглядности.
Если поможет облегчить задачу, есть один нюанс- строки которые подлежат удалению имеют в столбце D текст "Рек" на белом фоне. Если "Рек" написан на желтом фоне, то их нельзя удалять.
 
 
 
#2
28.03.2015 20:06:54
А что же в файле нет указанного макроса?
 
 
 
#3
28.03.2015 20:08:47
Этот макрос увы не подходит для этой задачи. Раньше были фиксированные обозначения, теперь их нет. Поэтому я его из книги исключил.
 
 
 
#4
28.03.2015 20:15:19
Можно таким макросом попробовать:
Код
Sub DelFromG()
Dim arrA()
Dim lngI As Long
Dim lngJ As Long
arrA = Range("G2").CurrentRegion 'заносим в массив все значения, которые удаляем (из столбца G)
    For lngI = Cells(Rows.Count, 4).End(xlUp).Row To 1 Step -1 'от последней заполненной строки до первой
        For lngJ = 1 To UBound(arrA, 1) 'сравниваем значение из ячейки в столбце В с каждым значением массива
            If Cells(lngI, 2) = arrA(lngJ, 1) Then 'если значение совпадает
                Cells(lngI, 2).EntireRow.Delete shift:=xlUp 'удаляем строку
                Exit For
            End If
        Next lngJ
    Next lngI
End Sub
Кому решение нужно - тот пример и рисует.
 
 
 
#5
28.03.2015 20:21:45
Раз нужно проверять только один столбец, то можно так:
Код
Sub DelRows()
Dim DelRa As Range, i As Long, LastRow As Long
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To LastRow
        If Cells(i, 4).Interior.ColorIndex = 36 Then'Здесь проверяем заливку
            If Cells(i, 4) = "Рек" Then
                If DelRa Is Nothing Then
                    Set DelRa = Cells(i, 4)
                Else
                    Set DelRa = Union(DelRa, Cells(i, 4))
                End If
            End If
        End If
    Next
    If Not DelRa Is Nothing Then DelRa.EntireRow.Delete
End Sub
 
 
 
#6
28.03.2015 20:22:13
Пытливый, спасибо огромное!
Очень сильно помог облегчить рутинный процесс!
 
 
 
#7
28.03.2015 20:34:59
Или так, без привязки к цвету
Код
Sub bb()
Cells.AutoFilter
Range("A:D").AutoFilter 2, Application.Transpose(Range("G2", Cells(Rows.Count, "G").End(xlUp)).Value), xlFilterValues
ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Delete xlShiftUp
Cells.AutoFilter
End Sub
Изменено: Казанский - 28.03.2015 20:36:21
 
 
 
#8
28.03.2015 20:42:46
У Пытливого тоже цвет не проверяется )
 
 
 
#9
20.01.2018 10:24:45
Подскажите, использую данный макрос.
ищу значение "840", но макрос находит все ячейки где есть сочетание этих цифр, а нужно чтобы удалял только если ячейка целиком содержит такое значение в столбце А. Как задать это условие, чтобы удалялись строки содержащие ячейку со значением 840 целиком??
Код
Dim ra As Range, delra As Range
    Columns("A:A").Select
    ÓäàëÿòüÑòðîêèÑÒåêñòîì = Array("840")
    For Each ra In ActiveSheet.UsedRange.Rows
        For Each word In ÓäàëÿòüÑòðîêèÑÒåêñòîì
            If Not ra.Find(word, , xlValues, xlPart) Is Nothing Then
                If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
            End If
        Next word
    Next
    If Not delra Is Nothing Then delra.EntireRow.Delete
 
 
 
#10
20.01.2018 11:02:40
Array(" 840 ") Пробелы поставить перед и после значения...
 
 
 
#11
20.01.2018 11:03:16
Цитата
gosmark написал:
Array(" 840 ") Пробелы поставить перед и после значения...
А нет, не помогло ((
 
 
 
#12
20.01.2018 11:16:50
Код
If Not ra.Find(word, , xlValues, xlWhole) Is Nothing Then
 
 
 
#13
20.01.2018 11:21:07
спасибо
Изменено: gosmark - 20.01.2018 11:22:03
 
 
 
Страницы: 1
Наверх