Comment éviter plusieurs If... then ?

[P96O1004]

Bonjour Forums,
Je dois comparer la cellule dans la colonne D avec des chaines de caractères. Si la condition est valide, je vais copier la ligne sur une autre onglet.
Mais quand il y a beaucoup de termes à comparer, le code devient lourd. Est-ce qu'il y a un moyen de créer une liste des termes ? Et si on veut ajouter une autre terme à vérifier, on doit juste ajouter dans la liste.

Merci bien

Voici mon code : (marché mais moche)

Sub filter()
Dim sd, sr As Worksheet

'On Error GoTo Alerte

Set sr = Sheets("DATA Import")
Set sd = Sheets("DATA Filter")
i = 3
j = 2
On Error Resume Next

While Not IsEmpty(sr.Range("D" & i).Value)
    If Not UCase(sr.Range("D" & i)) Like "*NYL*" Then
        If Not UCase(sr.Range("D" & i)) Like "*FILTER*" Then
            If Not UCase(sr.Range("D" & i)) Like "*LABEL*" Then
                If UCase(sr.Range("D" & i)) Like "*CAB*" Or UCase(sr.Range("D" & i)) Like "*WIRE*" Or UCase(sr.Range("D" & i)) Like "*THERMI*" Or UCase(sr.Range("D" & i)) Like "*FIL*" Then
                    sd.Range("B" & j & ":AH" & j).Value = sr.Range("A" & i & ":AG" & i).Value
                    sd.Range("A" & j).Value = i
                    j = j + 1
                ElseIf UCase(sr.Range("D" & i)) Like "*GAINE*" Or UCase(sr.Range("D" & i)) Like "*SHR*" Or UCase(sr.Range("D" & i)) Like "*HEAT-SH*" Or UCase(sr.Range("D" & i)) Like "*SHRINK*" Then
                    sd.Range("B" & j & ":AH" & j).Value = sr.Range("A" & i & ":AG" & i).Value
                    sd.Range("A" & j).Value = i
                    j = j + 1
                ElseIf UCase(sr.Range("D" & i)) Like "*W*" And UCase(sr.Range("D" & i)) Like "*UL*" Then
                    sd.Range("B" & j & ":AH" & j).Value = sr.Range("A" & i & ":AG" & i).Value
                    sd.Range("A" & j).Value = i
                    j = j + 1
                ElseIf UCase(sr.Range("D" & i)) Like "*GLAND*" Or UCase(sr.Range("D" & i)) Like "*GROMMET*" Or UCase(sr.Range("D" & i)) Like "*JOINT*" Then
                    sd.Range("B" & j & ":AH" & j).Value = sr.Range("A" & i & ":AG" & i).Value
                    sd.Range("A" & j).Value = i
                    j = j + 1
                ElseIf UCase(sr.Range("D" & i)) Like "*GASKET*" Or UCase(sr.Range("D" & i)) Like "*PVC*" Or UCase(sr.Range("D" & i)) Like "*FOAM*" Then
                    sd.Range("B" & j & ":AH" & j).Value = sr.Range("A" & i & ":AG" & i).Value
                    sd.Range("A" & j).Value = i
                    j = j + 1
                ElseIf UCase(sr.Range("D" & i)) Like "*SEBS*" Or UCase(sr.Range("D" & i)) Like "*EPDM*" Or UCase(sr.Range("D" & i)) Like "*RUBBER*" Then
                    sd.Range("B" & j & ":AH" & j).Value = sr.Range("A" & i & ":AG" & i).Value
                    sd.Range("A" & j).Value = i
                    j = j + 1
                End If
            End If
        End If
    End If
i = i + 1
Wend

End Sub

 

[bqtr]

Re : Comment éviter plusieurs If... then ?

Bonsoir P96O1004,

Tu crées ta liste dans une feuille (sauf les mots, NYL,FILTER, et LABEL).
Tu mets cette liste dans une variable tableau (ici la variable Tablo) et tu boucles dessus.

Sub filter()

Dim sd As Worksheet, sr As Worksheet
Dim Tablo, k As Long, i As Long, j As Long

Set sr = Sheets("DATA Import")
Set sd = Sheets("DATA Filter")
Tablo = Sheets("[B]XXXX nom de ta feuille où est la liste[/B]").Range("M1:M5")
i = 3
j = 2

While Not IsEmpty(sr.Range("D" & i).Value)
    If Not UCase(sr.Range("D" & i)) Like "*NYL*" Then
        If Not UCase(sr.Range("D" & i)) Like "*FILTER*" Then
            If Not UCase(sr.Range("D" & i)) Like "*LABEL*" Then
                    For k = 1 To UBound(Tablo)
                      If UCase(sr.Range("D" & i)) Like "*" & UCase(Tablo(k, 1)) & "*" Then
                         sd.Range("B" & j & ":AH" & j).Value = sr.Range("A" & i & ":AG" & i).Value
                         sd.Range("A" & j).Value = i
                         j = j + 1
                      End If
                    Next
            End If
        End If
    End If
    i = i + 1
Wend

End Sub

L'avantage de mettre la liste sur une feuille à part c'est que tu peux la mettre à jour facilement.

A+

Edit : Bonsoir soenda

 

[soenda]

Re : Comment éviter plusieurs If... then ?

Bonjour le fil, P96O1004

Vois si "l'élagage" ci-dessous n'est pas sufisant ... Et dis nous.

- L'idée étant que tu n'as peut-être pas besoin d'une liste ?

Sub test()
    Dim sd, sr As Worksheet
    Dim i&, j As Long
    Dim ch As String
    Set sr = Sheets("DATA Import")
    Set sd = Sheets("DATA Filter")
    i = 3
    j = 2
    While Not IsEmpty(sr.Range("D" & i))
        ch = UCase(sr.Range("D" & i))
        If InStr(ch, "NYL") + InStr(ch, "FILTER") + InStr(ch, "LABEL") = 0 Then
            sd.Range("B" & j & ":AH" & j) = sr.Range("A" & i & ":AG" & i)
            sd.Range("A" & j) = i
            j = j + 1
        End If
        i = i + 1
    Wend
End Sub

A plus

Edition : Bonjour bqtr