Macro de suppression de lignes.

[JJ1]

Bonjour à tous,

Je souhaiterais supprimer via une macro des lignes dans mon fichier sous 2 conditions:
-ne pas avoir 2 ou plus nombres en commun avec une saisie
-ne pas être la ligne au dessus d'un tel cas.
Je joins un exemple avec le résultat attendu en Feuil2.
Merci de votre aide.
Bon mardi

 

[JNP]

Re : Macro de suppression de lignes.

Bonjour JJ1 🙂,
Y a surement moyen de faire plus léger, mais ce code semble fonctionner

Sub test()
Dim Tableau(), I As Integer, J As Integer
I = 2
With Application.WorksheetFunction
While Cells(I, 1) <> ""
If .CountIf(Range(Cells(I, 1), Cells(I, 5)), Cells(1, 1)) _
    + .CountIf(Range(Cells(I, 1), Cells(I, 5)), Cells(1, 2)) _
    + .CountIf(Range(Cells(I, 1), Cells(I, 5)), Cells(1, 3)) _
    + .CountIf(Range(Cells(I, 1), Cells(I, 5)), Cells(1, 4)) _
    + .CountIf(Range(Cells(I, 1), Cells(I, 5)), Cells(1, 5)) < 2 Then
    If .CountIf(Range(Cells(I + 1, 1), Cells(I + 1, 5)), Cells(1, 1)) _
        + .CountIf(Range(Cells(I + 1, 1), Cells(I + 1, 5)), Cells(1, 2)) _
        + .CountIf(Range(Cells(I + 1, 1), Cells(I + 1, 5)), Cells(1, 3)) _
        + .CountIf(Range(Cells(I + 1, 1), Cells(I + 1, 5)), Cells(1, 4)) _
        + .CountIf(Range(Cells(I + 1, 1), Cells(I + 1, 5)), Cells(1, 5)) < 2 Then
        ReDim Preserve Tableau(J)
        Tableau(J) = I
        J = J + 1
    End If
End If
I = I + 1
Wend
End With
If J = 0 Then Exit Sub
For I = UBound(Tableau) To LBound(Tableau) Step -1
Rows(Tableau(I)).Delete
Next I
End Sub

Bonne journée 😎

 

[JJ1]

Re : Macro de suppression de lignes.

Bonjour JNP
Merci pour ton code que je vais tester ce soir.
Il y a longtemps que je n'avais vu IF...WEND.
Merci beaucoup et bonne journée

 

[pierrejean]

Re : Macro de suppression de lignes.

bonjour JJ1 🙂 ,Bonjour JNP 🙂

Une version differente qui semble fonctionner egalement

Sub efface()
mot = ";"
For Each cel In Range("A1:E1")
  mot = mot & cel & ";"
Next
For n = Range("A65536").End(xlUp).Row To 2 Step -1
  For p = 1 To 5
    If InStr(mot, ";" & Cells(n, p) & ";") <> 0 Then
      nb = nb + 1
    End If
  Next p
  If nb < 2 Then
    Rows(n).Delete
  Else
    n = n - 1
  End If
  nb = 0
Next n
End Sub

 

[JJ1]

Re : Macro de suppression de lignes.

Bonjour PierreJean et merci pour ta contribution. Ta solution n'est pas ordinaire, de passer par une variable "mot" et instr.
merci
Bon am

 

[JNP]

Re : Macro de suppression de lignes.

Re 🙂,

Il y a longtemps que je n'avais vu IF...WEND.

Tu voulais dire While ... Wend 😛...
Depuis Excel 2007, j'ai déjà eu des surprises avec End(XlUp) avec des cellules mal vidées, d'où ma préférence pour une boucle vérifiant le contenu de la cellule 😀!...
Bonne soirée 😎