Удаление всей строки при условиях vba excel

Sub Del_SubStr()
    Dim sSubStr As String 'искомое слово или фраза(может быть указанием на ячейку)
    Dim lCol As Long      'номер столбца с просматриваемыми значениями
    Dim lLastRow As Long, li As Long
    Dim lMet As Long
    Dim arr
 
    sSubStr = InputBox("Укажите значение, которое необходимо найти в строке", "www.excel-vba.ru", "")
    If sSubStr = "" Then lMet = 0 Else lMet = 1
    lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "www.excel-vba.ru", 1))
    If lCol = 0 Then Exit Sub
 
    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    arr = Cells(1, lCol).Resize(lLastRow).Value
    Application.ScreenUpdating = 0
    Dim rr As Range
    For li = 1 To lLastRow 'цикл с первой строки до конца
        If -(InStr(arr(li, 1), sSubStr) > 0) = lMet Then
            If rr Is Nothing Then
                Set rr = Cells(li, 1)
            Else
                Set rr = Union(rr, Cells(li, 1))
            End If
        End If
    Next li
    If Not rr Is Nothing Then rr.EntireRow.Delete
    Application.ScreenUpdating = 1
End Sub

Sub Del_SubStr()
    Dim sSubStr As String 'искомое слово или фраза(может быть указанием на ячейку)
    Dim lCol As Long 'номер столбца с просматриваемыми значениями
    Dim lLastRow As Long, li As Long
    Dim arr
 
    sSubStr = InputBox("Укажите значение, которое необходимо найти в строке", "www.excel-vba.ru", "")
    lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "www.excel-vba.ru", 1))
    If lCol = 0 Then Exit Sub
 
    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    arr = Cells(1, lCol).Resize(lLastRow).Value
 
    Application.ScreenUpdating = 0
    Dim rr As Range
    For li = 1 To lLastRow 'цикл с первой строки до конца
        If CStr(arr(li, 1)) = sSubStr Then
            If rr Is Nothing Then
                Set rr = Cells(li, 1)
            Else
                Set rr = Union(rr, Cells(li, 1))
            End If
        End If
    Next li
    If Not rr Is Nothing Then rr.EntireRow.Delete
    Application.ScreenUpdating = 1
End Sub

Sub Del_Array_SubStr()
    Dim sSubStr As String    'искомое слово или фраза
    Dim lCol As Long    'номер столбца с просматриваемыми значениями
    Dim lLastRow As Long, li As Long
    Dim avArr, lr As Long
    Dim arr
 
    lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "www.excel-vba.ru", 1))
    If lCol = 0 Then Exit Sub
    Application.ScreenUpdating = 0
    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    'заносим в массив значения листа, в котором необходимо удалить строки
    arr = Cells(1, lCol).Resize(lLastRow).Value
    'Получаем с Лист2 значения, которые надо удалить в активном листе
    With Sheets("Лист2") 'Имя листа с диапазоном значений на удаление
        avArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    'удаляем
    Dim rr As Range
    For lr = 1 To UBound(avArr, 1)
        sSubStr = avArr(lr, 1)
        For li = 1 To lLastRow 'цикл с первой строки до конца
            If CStr(arr(li, 1)) = sSubStr Then
                If rr Is Nothing Then
                    Set rr = Cells(li, 1)
                Else
                    Set rr = Union(rr, Cells(li, 1))
                End If
            End If
            DoEvents
        Next li
        DoEvents
    Next lr
    If Not rr Is Nothing Then rr.EntireRow.Delete
    Application.ScreenUpdating = 1
End Sub

If CStr(arr(li, 1)) = sSubStr Then

If InStr(1, arr(li, 1), sSubStr, 1) > 0 Then

'процедура оставляет в листе только те значения, которые перечислены в списке
Sub LeaveOnlyFoundInArray()
    Dim sSubStr As String   'искомое слово или фраза
    Dim lCol As Long        'номер столбца с просматриваемыми значениями
    Dim lLastRow As Long, li As Long
    Dim avArr, lr As Long
    Dim arr
    Dim IsFind As Boolean
 
    lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "www.excel-vba.ru", 1))
    If lCol = 0 Then Exit Sub
    Application.ScreenUpdating = 0
    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    'заносим в массив значения листа, в котором необходимо удалить строки
    arr = Cells(1, lCol).Resize(lLastRow).Value
    'Получаем с Лист2 значения, которые надо удалить в активном листе
    With Sheets("Лист2") 'Имя листа с диапазоном значений на удаление
        avArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    'удаляем
    Dim rr As Range
    For li = 1 To lLastRow 'цикл с первой строки таблицы до конца
        IsFind = False
        For lr = 1 To UBound(avArr, 1) 'цикл по списку значений на удаление
            sSubStr = avArr(lr, 1)
            If InStr(1, arr(li, 1), sSubStr, 1) > 0 Then
                IsFind = True
            End If
            DoEvents
        Next lr
        'если значение таблицы не найдено в списке - удаляем строку
        If Not IsFind Then
            If rr Is Nothing Then
                Set rr = Cells(li, 1)
            Else
                Set rr = Union(rr, Cells(li, 1))
            End If
        End If
        DoEvents
    Next li
    If Not rr Is Nothing Then rr.EntireRow.Delete
    Application.ScreenUpdating = 1
End Sub

If InStr(1, arr(li, 1), sSubStr, 1) > 0 Then

If CStr(arr(li, 1)) = sSubStr Then

If Not rr Is Nothing Then rr.EntireRow.Delete

If Not rr Is Nothing Then rr.EntireRow.Hidden = True

For li = 1 To lLastRow 'цикл с первой строки до конца

For li = 7 To lLastRow 'цикл с седьмой строки до конца

For li = 3 To 300 'цикл с третьей строки до трехсотой

Sub УдалениеСтрокПоУсловию()
    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) Is Nothing 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.Delete
End Sub

If Not delra Is Nothing Then delra.EntireRow.Delete

If Not delra Is Nothing Then delra.EntireRow.Hidden=TRUE

Function ПоискСтрокПоУсловию(ByVal ТекстДляПоиска As String, Optional HideOnly As Boolean) As Long
    ' функция получает в качестве параметра ТекстДляПоиска (можно использовать символы * и ?)
    ' Если HideOnly = TRUE, то строки, содержащие в ячейках ТекстДляПоиска, скрываются,
    ' иначе (HideOnly = FALSE - по умолчанию) - удаляются
    ' Функция возвращает количество удалённых строк
    Dim ra As Range, delra As Range
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' если в строке найден искомый текст
        If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
            ' добавляем строку в диапазон для удаления
            If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
    Next
    On Error Resume Next: ПоискСтрокПоУсловию = delra.Areas.Count ' количество найденных строк
    
    If Not delra Is Nothing Then    ' если подходящие строки найдены - скрываем или удаляем их
        If HideOnly Then delra.EntireRow.Hidden = True Else delra.EntireRow.Delete
    End If
End Function

Sub УдалениеСтрокПоНесколькимУсловиям()
    Dim ra As Range, delra As Range
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ' ищем и удаляем строки, содержащие заданный текст
    ' (можно указать сколько угодно значений, и использовать подстановочные знаки)
    УдалятьСтрокиСТекстом = Array("Наименование *", "Количество", _
                                  "текст?", "цен*сти", "*78*")
 
    ' перебираем все строки в используемом диапазоне листа
    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    ' удаляем их
End Sub

In this Article

• Delete Entire Row or Column
  • Delete Multiple Rows or Columns
• Delete Blank / Empty Rows
  • Delete Row if Cell is Blank
• Delete Row Based on Cell Value
• More Delete Row and Column Examples
  • Delete Duplicate Rows
  • Delete Table Rows
  • Delete Filtered Rows
  • Delete Rows in Range
  • Delete Selected Rows
  • Delete Last Row
  • Delete Columns by Number

4

В Excel вы можете применить мощную функцию «Найти и заменить», чтобы легко удалять строки на основе определенного значения ячейки. Пожалуйста, сделайте следующее:

1. Выберите диапазон, в котором вы будете удалять строки на основе определенного значения ячейки, и откройте диалоговое окно «Найти и заменить», нажав кнопку Ctrl + F ключи одновременно.

2. В диалоговом окне «Найти и заменить» введите определенное значение ячейки (в нашем случае мы вводим Soe) в Find what и нажмите Find All кнопка. См. Первый снимок экрана ниже:

3. Выберите все результаты поиска в нижней части диалогового окна «Найти и заменить» и закройте это диалоговое окно. (Внимание: Вы можете выбрать один из результатов поиска, а затем Ctrl + A клавиши для выбора всех найденных результатов. См. Второй снимок экрана выше.)
И тогда вы можете увидеть, что все ячейки, содержащие определенное значение, выбраны.

4. Щелкните правой кнопкой мыши выбранные ячейки и выберите Delete из контекстного меню. А затем проверьте Entire row во всплывающем диалоговом окне Удалить и щелкните OK кнопка. Теперь вы увидите, что все ячейки, содержащие определенное значение, удалены. Смотрите скриншоты ниже:

А затем были удалены целые строки на основе уже определенного значения.

С помощью следующего кода VBA вы можете быстро удалить строки с определенным значением ячейки, выполните следующие действия:

1, нажмите Alt + F11 ключи одновременно, чтобы открыть Microsoft Visual Basic for applications окно,

2. Нажмите Insert > Module, и введите в модуль следующий код:

VBA: удалить целые строки на основе значения ячейки

Sub DeleteRows()
'Updateby20211217
Dim rng As Range
Dim InputRng As Range
Dim DeleteRng As Range
Dim DeleteStr As String
Dim xTitleId As String
Dim xArr
Dim xF As Integer
Dim xWSh As Worksheet
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set rng = Application.Selection
Set InputRng = Application.InputBox("Range :", xTitleId, rng.Address, Type:=8)
If InputRng Is Nothing Then Exit Sub
DeleteStr = Application.InputBox("Delete Text", xTitleId, Type:=2)
Set xWSh = InputRng.Worksheet
For Each rng In InputRng
    If rng.Value = DeleteStr Then
        If DeleteRng Is Nothing Then
            Set DeleteRng = rng
        Else
            Set DeleteRng = Application.Union(DeleteRng, rng)
            Set DeleteRng = DeleteRng.EntireRow
        End If
    End If
Next
xArr = Split(DeleteRng.AddressLocal, ",")
DeleteRng.Select
DeleteRng.Delete
For xF = UBound(xArr) To 0 Step -1
    Set DeleteRng = xWSh.Range(xArr(xF))
    DeleteRng.Delete
Next
End Sub

3, Затем нажмите Run кнопку для запуска кода.

4. Во всплывающем диалоговом окне выберите диапазон, в котором вы будете удалять строки на основе определенного значения, и нажмите кнопку OK кнопку.

5. В другом диалоговом окне введите определенное значение, на основе которого вы будете удалять строки, и нажмите кнопку OK кнопка. Смотрите скриншот:

И тогда вы увидите, что целые строки были удалены на основе уже указанного значения.

Если вы установили Kutools for Excel, Его Select Specific Cells Функция может помочь вам быстро удалить строки с определенным значением. Пожалуйста, сделайте следующее:

Kutools for Excel — Включает более 300 удобных инструментов для Excel. Полнофункциональная бесплатная пробная версия 30-день, кредитная карта не требуется! Get It Now

1. Выберите диапазон, в котором вы будете удалять строки на основе определенного значения, и нажмите Kutools > Select > Select Specific Cells. Смотрите скриншот:

2. В открывшемся диалоговом окне Select Specified Cells установите флажок Entire row выберите, выберите Contains от Specific type раскрывающийся список, введите указанное значение в правое поле и щелкните значок Ok кнопку (см. снимок экрана выше).
После применения этой функции появится диалоговое окно, в котором будет показано, сколько ячеек было найдено в соответствии с указанными критериями. Пожалуйста, нажмите на OK чтобы закрыть его.

3. Теперь выбираются целые строки с определенным значением. Щелкните правой кнопкой мыши выбранные строки и щелкните значок Delete из контекстного меню. Смотрите скриншот ниже:

Внимание: Это Select Specific Cells функция поддерживает удаление строк на одно или два определенных значения. Для удаления строк на основе двух указанных значений укажите другое значение в поле Specific type раздел диалогового окна Select Specific Cells, как показано на следующем снимке экрана:

Kutools for Excel — Включает более 300 удобных инструментов для Excel. Полнофункциональная бесплатная пробная версия 30-день, кредитная карта не требуется! Get It Now

В некоторых случаях вам может потребоваться удалить строки на основе нескольких значений ячеек из другого столбца / списка в Excel. Здесь я представлю Kutools for Excel‘s Select Same & Different Cells функция, чтобы быстро и легко решить эту проблему.

Kutools for Excel — Включает более 300 удобных инструментов для Excel. Полнофункциональная бесплатная пробная версия 30-день, кредитная карта не требуется! Get It Now

1. Нажмите Kutools > Select > Select Same & Different Cells , чтобы открыть диалоговое окно Выбрать одинаковые и разные ячейки.

2. В открытии Select Same & Different Cells диалоговое окно, сделайте следующее (см. снимок экрана):

(1) В Find values in поле, выберите столбец, в котором вы найдете определенные значения;
(2) В According to поле, выберите столбец / список с несколькими значениями, на основе которых вы будете удалять строки;
(3) В Based on раздел, пожалуйста, проверьте Each row вариант;
(4) В Find раздел, пожалуйста, проверьте Same Values вариант;
(5) Проверьте Select entire rows опция внизу открывающегося диалогового окна.
Внимание: Если два указанных столбца содержат один и тот же заголовок, проверьте My data has headers опцию.

3, Нажмите Ok кнопку, чтобы применить эту утилиту. Затем появляется диалоговое окно, в котором показано, сколько строк было выбрано. Просто нажмите на OK чтобы закрыть его.

Затем были выбраны все строки, содержащие значения из указанного списка.

4. Нажмите Home > Delete > Delete Sheet Rows для удаления всех выбранных строк.