Find multicritere

Bonjour,

J'ai ce petit code qui fonctionne mais j’aimerais rajouter plusieurs mots ("DIVERS"; "autres"....)?

Dim D As Range

Do

Set D = Columns(5).Find("Divers", , , xlWhole)

If D Is Nothing Then Exit Sub

D.EntireRow.Delete

Loop

Apres plusieurs tests sans effet je fait appel a vous...

MErci d'avance...

Bonjour,

Comme tu veux faire une suppression de ligne, ce n'est pas conseillé de le faire avec Find(), il est préférable de récupérer les numéros des lignes dans un tableau, trier ce dernier en décroissant (ce qui permet de supprimer les lignes en commençant par le bas) et effectuer la suppression :

Sub Test()

    Dim Tbl() As Long
    Dim T
    Dim D As Range
    Dim I As Long
    Dim J As Long
    Dim Adr As String
    Dim Tempo As Long

    T = Array("Divers", "Autres", "Truc", "Bidule")

    For I = 0 To UBound(T)

        Set D = Columns(5).Find(T(I), , , xlWhole)

        If Not D Is Nothing Then

            Adr = D.Address

            Do

                J = J + 1: ReDim Preserve Tbl(1 To J)
                Tbl(J) = D.Row

                Set D = Columns(5).FindNext(D)

            Loop While D.Address <> Adr

        End If

    Next I

    'si le tableau a été initialisé
    If Not Not Tbl Then

        'effectue un tri décroissant pour faire la suppression des lignes en commençant par le bas
        For I = 1 To UBound(Tbl) - 1: For J = I + 1 To UBound(Tbl)

                If Tbl(I) < Tbl(J) Then

                    Tempo = Tbl(J): Tbl(J) = Tbl(I): Tbl(I) = Tempo

                End If

        Next J, I

        'suppression des lignes
        For I = 1 To UBound(Tbl): Rows(Tbl(I)).Delete: Next I

    End If

End Sub