Façon efficace de supprimer la ligne entière si la cellule ne contient pas '@'

au lieu de boucler et référencer chaque cellule 1 par 1, prenez tout et mettez-la dans une variante de réseau; Ensuite, bouclez le tableau de variante.

Démarreur: P>

Sub DeleteRowsWithValue(Value As String, Column As Long, StartingRow As Long, Optional Sheet)
Dim i As Long, LastRow As Long
Dim vData() As Variant
Dim DeleteAddress As String

    ' Sheet is a Variant, so we test if it was passed or not.
    If IsMissing(Sheet) Then Set Sheet = ActiveSheet
    ' Get the last row
    LastRow = Sheet.Cells(Sheet.Rows.Count, Column).End(xlUp).Row
    ' Make sure that there is work to be done
    If LastRow < StartingRow Then Exit Sub

    ' The Key to speeding up the function is only reading the cells once 
    ' and dumping the values to a variant array, vData
    vData = Sheet.Cells(StartingRow, Column) _
                 .Resize(LastRow - StartingRow + 1, 1).Value
    ' vData will look like vData(1 to nRows, 1 to 1)
    For i = LBound(vData) To UBound(vData)
        ' Find the value inside of the cell
        If InStr(vData(i, 1), Value) > 0 Then
            ' Adding the StartingRow so that everything lines up properly
            DeleteAddress = DeleteAddress & ",A" & (StartingRow + i - 1)
        End If
    Next
    If DeleteAddress <> vbNullString Then
        ' remove the first ","
        DeleteAddress = Mid(DeleteAddress, 2)
        ' Delete all the Rows
        Sheet.Range(DeleteAddress).EntireRow.Delete
    End If
End Sub