Как удалить все строки из нескольких записей, даже если только одна строка соответствует заданным критериям

Question

Ниже приведен текущий (неполный) код, который я использую, который отлично работает для удаления любой данной строки, но мне действительно нужно определить строки, которые соответствуют определенным критериям:
Значение ячейки в столбце L> 90%
OR
Значение ячейки в столбце M> 90%

Тогда, если любой из них верен, мне нужно найти значение ячейки в той же строке столбца G и удалить все строки, содержащие это же значение в столбце G.

   Sub sbDelete_Rows_Based_On_Multiple_Criteria()
    Dim lRow As Long
    Dim iCntr As Long
    lRow = Cells(Rows.Count, "G").End(xlUp).Row
    For iCntr = lRow To 2 Step -1
        If Cells(iCntr, "L") > 0.90 OR Cells(iCntr, "M") > 0.90 Then
            Cells(iCntr, "G").EntireRow.Delete
        End If
    Next iCntr
  End Sub

-

То, что я надеюсь выполнить в моем примере, приведет к тому, что единственный серийный номер, который НЕ будет удален, будет 1910910

заранее благодарю за помощь.

Answer 1

Вы можете использовать массив для хранения значений из столбца G при соблюдении критериев! Примерно так:

Sub DeleteValues()

Dim myArray() As Variant
Dim x as long, y as long

'Loop through all rows
For x = 2 to ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    If Range("L" & x).value > 0.9 or Range("M" & x).value > 0.9 then
        ReDim Preserve myArray(y)
        myArray(y) = Range("G" & x).value        
        y = y + 1
    End if
Next x

'Delete all rows that contain a value that occurs in your array
For x = LBound(myArray) To UBound(myArray)
StartOver:  With Worksheets(1).Range("G2:G" & ActiveSheet.Range("A" &     Rows.Count).End(xlUp).Row)
        Set c = .Find(myArray(x), lookin:=xlValues)
        If Not c Is Nothing Then
            Rows(c.row).entirerow.delete                
            goto StartOver
        End If
    End With
Next x

End sub

Answer 2

Sub ToDelete()

    Dim last_row&

    '// NOTE! The code assumes that range:
    '// 1) starts in column A
    '// 2) ends in column O
    last_row = Cells(Rows.Count, "G").End(xlUp).Row
    '// Helper column 1
    With Range("P2:P" & last_row)
        .Formula = "=IF(OR(M2>0.9,L2>0.9),1,0)"
        .Value = .Value 'Overwrite formula
    End With
    '// Helper column 2
    With Range("Q2:Q" & last_row)
        .Formula = "=IF(SUMIF(G:G,G2,P:P)>0,1,0)"
        .Value = .Value 'Overwrite formula
    End With

    Rows(1).CurrentRegion.AutoFilter Field:=17, Criteria1:=1
    Rows("2:" & last_row).EntireRow.Delete
    ActiveSheet.AutoFilterMode = False 'Remove filter
    Columns("P:Q").Delete 'Remove helper columns

End Sub