Как удалить строки на листе Excel на основе критериев

#excel #vba

#excel #vba

Вопрос:

У меня есть книга Excel, в worksheet1 в столбце A, ЕСЛИ значение этого столбца = ERR Я хочу, чтобы оно было удалено (вся строка), как это возможно?

PS: имейте в виду, что я никогда раньше не использовал VBA или макросы, поэтому подробное описание очень ценится.

Комментарии:

1. Мэн, мне любопытно, вы прочитали мой ответ, было ли что-то, чего вы не понимаете в этом?

2. Я согласен с Реафиди, его код был более компактным. Возможно, вы пропустили его обновление с несколькими листами?

Ответ №1:

Использование автофильтра вручную или с помощью VBA (как показано ниже) — очень эффективный способ удаления строк

Приведенный ниже код

  1. Работает со всем используемым диапазоном, т.Е. Обрабатывает пробелы
  2. Можно легко перенести на другие листы, изменив strSheets = Array(1, 4) . т.е. Этот код в настоящее время выполняется на первом и четвертом листах

      Option Explicit
    
    
    Sub KillErr()
    Dim ws As Worksheet
    Dim lRow As Long
    Dim lngCol As Long
    Dim rng1 As Range
    Dim strSheets()
    Dim strws As Variant
    strSheets = Array(1, 4)
    For Each strws In strSheets
        Set ws = Sheets(strws)
        lRow = ws.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
        lngCol = ws.Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
        Application.ScreenUpdating = False
        ws.Rows(1).Insert
        Set rng1 = ws.Range(ws.Cells(1, lngCol), ws.Cells(lRow   1, lngCol))
        With rng1.Offset(0, 1)
            .FormulaR1C1 = "=RC1=""ERR"""
            .AutoFilter Field:=1, Criteria1:="TRUE"
            .EntireRow.Delete
            On Error Resume Next
            .EntireColumn.Delete
            On Error GoTo 0
        End With
    Next
    Application.ScreenUpdating = True
    End Sub
      

Комментарии:

1. спасибо, нико 🙂 хотя в этом случае мне нравится более прямая версия Reafidy в качестве моего рабочего столбца в ненужном в этом случае, когда условие добавлять не нужно. Комбинация кода Reafidy с моей оценкой массива листов, вероятно, является лучшим общим решением.

2. Спасибо за ответ, я вставил его, и он работал на первом листе и только тогда, когда ошибка находится в первом столбце, и я все равно получил ошибку: ошибка времени выполнения «91» Переменная объекта или с переменной блока не установлена. итак, как мне заставить это работать для других листов и других столбцов?

3. Ошибка в: lRow = ws.Cells. Найти («*», , xlValues, , xlByRows, xlPrevious).Строка

4. Я думаю, ваш код должен иметь больше смысла! 😉 Ну что ж, ты что-то выигрываешь, что-то теряешь! Все хорошо.

5. 🙂 да, у меня было несколько решений, которые я считал более эффективными / надежными / гибкими, которые я пропустил. Я думаю, что это первый случай в SO, когда ситуация изменилась на противоположную

Ответ №2:

   sub delete_err_rows()
      Dim Wbk as Excel.workbook  'create excel workbook object
      Dim Wsh as worksheet       ' create excel worksheet object 
      Dim Last_row as long
      Dim i as long
      Set Wbk = Thisworkbook ' im using thisworkbook, assuming current workbook
                             ' if you want any other workbook just give the name 
                             ' in invited comma as "workbook_name"
      Set Wsh ="sheetname"   ' give the sheet name here 
      Wbk.Wsh.activate
     ' it means Thisworkbook.sheets("sheetname").activate
     ' here the sheetname of thisworkbook is activated
     ' or if you want looping between sheets use thisworkbook.sheets(i).activate
     ' put it in loop , to loop through the worksheets
     ' use thisworkbook.worksheets.count to find number of sheets in workbook
     Last_row = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row 'to find the lastrow of the activated sheet
          For i = lastrow To 1 step -1
             if activesheet.cells(i,"A").value = "yourDesiredvalue"
                  activesheet.cells(i,"A").select  ' select the row
                  selection.entirerow.delete       ' now delete the entire row
             end if
          Next i
   end sub
  

Обратите внимание, что любые операции, которые вы выполняете с помощью activesheet, будут затронуты на текущем активированном листе

Как вы говорите, ваш начинающий, почему бы вам не записать макрос и не проверить, это лучший способ автоматизировать ваш процесс, просмотрев фоновый код

Просто найдите вкладку макросы на листе и нажмите записать новый макрос, затем выберите любую строку и сделайте то, что вы хотели сделать, скажем, удалите всю строку, просто удалите всю строку, а теперь вернитесь на вкладку макросы и нажмите остановить запись .

Теперь нажмите alt F11, это приведет вас в редактор VBA, там вы найдете несколько листов и модулей в поле vba project Explorer, если вы не нашли его, выполните поиск с помощью вкладки view редактора VBA, теперь нажмите module1 и посмотрите записанный макрос, вы найдете что-то вроде этого

         selection.entirerow.delete
  

Надеюсь, я вам немного помог, и если вам нужна дополнительная помощь, пожалуйста, дайте мне знать, спасибо

Комментарии:

1. Нико, ты не можешь удалять такие строки. Опубликованный вами код даст очень плохие результаты. Вместо этого вы должны работать в обратном направлении. For i = Last_row To 1 Step -1

2. @Reafidy абсолютно, я просто забыл, что я благодарен за обнаружение ошибки в моем коде! отличная помощь, спасибо!

3. Упс, забыл добавить 1!

Ответ №3:

Самый быстрый метод:

 Sub DeleteUsingAutoFilter()

    Application.ScreenUpdating = False

    With ActiveSheet
        .AutoFilterMode = False

        .Columns("A").AutoFilter Field:=1, Criteria1:="ERR"

        .AutoFilter.Range.Offset(1, 0).EntireRow.Delete        

        .AutoFilterMode = False
    End With

    Application.ScreenUpdating = True

End Sub
  

Второй самый быстрый метод (у этого тоже много вариантов):

 Sub DeleteWithFind()
    Dim rFound As Range, rDelete As Range
    Dim sAddress As String

    Application.ScreenUpdating = False

    With Columns("A")
        Set rFound = .Find(What:="ERR", After:=.Resize(1, 1), SearchOrder:=xlByRows)

        If Not rFound Is Nothing Then
            Set rDelete = rFound                
            Do
                Set rDelete = Union(rDelete, rFound)
                Set rFound = .FindNext(rFound)
            Loop While rFound.Row > rDelete.Row                
        End If

        If Not rDelete Is Nothing Then rDelete.EntireRow.Delete

    End With

    Application.ScreenUpdating = True

End Sub
  

Метод автоматической фильтрации для нескольких листов:

 Sub DeleteUsingAutoFilter()
    Dim vSheets As Variant
    Dim wsLoop As Worksheet

    Application.ScreenUpdating = False

    '// Define worksheet names here
    vSheets = Array("Sheet1", "Sheet2")

    For Each wsLoop In Sheets(vSheets)

         With wsLoop
             .AutoFilterMode = False

             .Columns("A").AutoFilter Field:=1, Criteria1:="ERR"

             .AutoFilter.Range.Offset(1, 0).EntireRow.Delete

             .AutoFilterMode = False
         End With

    Next wsLoop

    Application.ScreenUpdating = True

End Sub
  

Комментарии:

1. @Refidy 1 отличная работа! никогда не видел подобного кода для удаления строки!

2. 1 Приятный и прямой с автофильтром. Из комментария Мэна внизу может быть полезна небольшая настройка для обработки нескольких листов.

3. @brett amp; niko, спасибо! — Я обновил для нескольких листов в соответствии с вашим предложением.

Ответ №4:

Предполагая, что в ячейках столбца A всегда есть значения и что данные находятся на первом листе, тогда что-то вроде этого должно делать то, что вы хотите:

 Sub deleteErrRows()
    Dim rowIdx As Integer
    rowIdx = 1

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(1)

    While ws.Cells(rowIdx, 1).Value <> ""
        If ws.Cells(rowIdx, 1).Value = "ERR" Then
            ws.Cells(rowIdx, 1).EntireRow.Delete
        Else
            rowIdx = rowIdx   1
        End If
    Wend
End Sub
  

Комментарии:

1. Спасибо за ответ, мне понадобится этот макрос для более чем одного листа внутри одной книги, поэтому он не всегда является первым листом, а рассматриваемый столбец не является непрерывным (иногда есть пробелы), но в моем состоянии я ищу конкретный текст, такой как «ОШИБКА»