Discussion :

[gege765]

Bonjour,
J'aimerais supprimer des lignes si les cellules de la colonne A1 ne contiennent pas les valeurs suivantes 1,2...48 ou A1, A2...G24 ou Trk1...Trk12

Je sais que cela représente un certain nombre de conditions donc est-ce possible de faire cela ?
Y aurait-il une autre façon de faire ?

Car j'ai déjà fait une petite macro qui supprime une ligne selon 2 critères (les cellules de la colonne D et E contiennent la valeur 0).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Sub SupLignes()
Dim L As Long
For L = 5001 To 2 Step -1
   If Feuil1.Cells(L, 4).Value = 0 And Feuil1.Cells(L, 5).Value = 0 Then Feuil1.Rows(L).Delete
   Next L
End Sub

La le nombre de conditions me parait entrainement nombreux et je me pose la question de la faisabilité.

Merci de votre avis

[fring]

Bonjour,

Un exemple pour la colonne A

• condition 1 = valeur comprise entre Trk1 et Trk12
• condition 2 = valeur comprise entre A1 et G24
• condition 3 = valeur comprise entre 1 et 48

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub test()
Dim i As Integer
 
With Sheets("Feuil1")
    'boucle de la dernière ligne de la colonne A à la ligne 2
    For i = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        If Left(.Cells(i, 1), 3) = "Trk" Then '<-- si la cellule commence par Trk (condition 1)
            Select Case Mid(.Cells(i, 1), 4) '<-- vérification des caractères qui suivent Trk
                Case 1 To 12: .Cells(i, 1).EntireRow.Delete '<-- si c'est compris entre 1 et 12 on supprime la ligne
            End Select
        Else '<-- si la condition 1 n'est pas remplie
            Select Case Asc(Left(.Cells(i, 1), 1)) '<-- vérification du code Ascii du premier caractère de la cellule (condition 2)
                Case 65 To 71 '<-- si le code Ascii est compris entre 65 et 71 (de A à G majuscule)
                    Select Case Mid(.Cells(i, 1), 2) '<-- vérification des caractères qui suivent A...G
                        Case 1 To 24: .Cells(i, 1).EntireRow.Delete '<-- si c'est compris entre 1 et 24 on supprime la ligne
                    End Select
            Case Else '<-- si les conditions 1 et 2 ne sont pas remplies
                Select Case .Cells(i, 1) '<-- vérification du contenu de la cellule (condition 3)
                    Case 1 To 48: .Cells(i, 1).EntireRow.Delete '<-- si c'est compris entre 1 et 48 on supprime la ligne
                End Select
            End Select
        End If
    Next
End With
End Sub

[gege765]

Merci de ton aide.
Cependant c'est le contraire que je souhaite faire
supprimer des lignes si les cellules de la colonne A1 ne contiennent pas les valeurs suivantes 1,2...48 ou A1, A2...G24 ou Trk1...Trk12

Peux tu m'aider, il y a certainement peu d'éléments à modifier ?

Merci.

[fring]

Sorry j'avais mal lu...

Tu peux faire comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub test()
Dim i As Integer
 
With Sheets("Feuil1")
    'boucle de la dernière ligne de la colonne A à la ligne 2
    For i = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        If Left(.Cells(i, 1), 3) = "Trk" Then '<-- si la cellule commence par Trk (condition 1)
            Select Case Mid(.Cells(i, 1), 4) '<-- vérification des caractères qui suivent Trk
                Case 1 To 12: GoTo suite '<-- si c'est compris entre 1 et 12 on passe la ligne
            End Select
        Else '<-- si la condition 1 n'est pas remplie
            Select Case Asc(Left(.Cells(i, 1), 1)) '<-- vérification du code Ascii du premier caractère de la cellule (condition 2)
                Case 65 To 71 '<-- si le code Ascii est compris entre 65 et 71 (de A à G majuscule)
                    Select Case Mid(.Cells(i, 1), 2) '<-- vérification des caractères qui suivent A...G
                        Case 1 To 24: GoTo suite '<-- si c'est compris entre 1 et 24 on passe la ligne
                    End Select
            Case Else '<-- si les conditions 1 et 2 ne sont pas remplies
                Select Case .Cells(i, 1) '<-- vérification du contenu de la cellule (condition 3)
                    Case 1 To 48: GoTo suite '<-- si c'est compris entre 1 et 48 on passe la ligne
                End Select
            End Select
        End If
    .Cells(i, 1).EntireRow.Delete '<-- si aucune des 3 conditions n'est remplie on supprime la ligne
suite:
    Next
End With
End Sub

[gege765]

ok merci bien