XL 2019 Suppressions de lignes sous condition

[cyril01250]

Bonjour,
je souhaite supprimer des lignes si la colonne A et B contiennent la même valeur numérique dans un tableau qui contient un nombre variable de lignes.
En cherchant, des macros existent avec une seule condition ou plusieurs conditions dans une même colonne.
En vous remerciant pour l'aide apportée.
Cordialement
Cyril

 

[R@chid]

Bonsoir et Bienvenue sur XLD,
Une âme charitable va surement passer par là pour te tisser une macro.
En attendant voir si cela te convient.

Cordialement

 

[sylvanu]

Bonjou Cyril,R@chid,
Un PJ un essai en VBA avec :

Sub SupprimeLignes()
Application.ScreenUpdating = False
DL = Range("A65500").End(xlUp).Row
For L = DL To 2 Step -1                     ' pour chaque ligne
    If Cells(L, "A") = Cells(L, "B") Then   ' si les 2 valeurs sont égales
        Cells(L, 1).EntireRow.Delete        ' on supprime la ligne
    End If
Next L
End Sub

Sans passer par des arrays, cette solution simple est rapide si le nombres de lignes n'est pas très important
( <1000 )
sinon il faudra passer par une méthode plus efficace.

 

[Staple1600]

Bonjour le fil

Une autre façon de faire (sans boucle)
NB: même précaution d'usage que sylvanu
Fonctionne bien si pas trop de données

Sub SupprimeLignesB()
Dim r As Range
Application.ScreenUpdating = False
 f = "=IF(AND(COUNTA(RC1:RC2)>1,RC1=RC2),CHAR(166),0)"
DL = Cells(Rows.Count, 1).End(xlUp).Row
Set r = Cells(1, Columns.Count).Resize(DL)
r.FormulaR1C1 = f
r.SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
r.Clear
End Sub

 

[sylvanu]

Bonjou Cyril,R@chid, Staple,
@Staple,
Votre macro est ralentie par le fait le travail s'effectue alors que plein de formules sont présentes.
Alors plus rapide encore :

Sub SupprimeLignesC()
Dim T0, DL
T0 = Timer
Application.ScreenUpdating = False
DL = Range("A65500").End(xlUp).Row
With ActiveSheet.UsedRange
    .Columns(5).EntireColumn.Insert
    With Range(Cells(2, 5), Cells(DL, 5))
        .FormulaR1C1 = "=IF(AND(COUNTA(RC1:RC2)>1,RC1=RC2),1,"""")"
        .Value = .Value
        .EntireRow.Sort .Cells, xlDescending
        On Error Resume Next
        .SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete
        .EntireColumn.Delete
    End With
End With
With ActiveSheet.UsedRange: End With
[L1] = " Temps de traitement : " & Round(1000 * (Timer - T0)) & "ms."
End Sub

Sur mon PC avec 10 000 lignes : 120ms.

 

[mapomme]

Bonjour à tous,

Pour de gros volume de données, on peut utiliser un filtre avancé.
Le fichier joint initialise le nombre de ligne que vous désirez.
Le code dans module1 :

Sub SupprimeLignes()
Dim deb, macol&, der&
   deb = Timer: Application.ScreenUpdating = False
   With Worksheets("Feuil1")
      macol = Cells.SpecialCells(xlCellTypeLastCell).Column + 2
      .Cells(2, macol).Formula = "=A2<>B2"
      .Range("A1").CurrentRegion.Resize(, 2).AdvancedFilter Action:=xlFilterCopy, Unique:=False _
         , CriteriaRange:=.Cells(1, macol).Resize(2), CopyToRange:=.Cells(1, macol + 2).Resize(, 2)
      .Cells(1, macol + 2).Resize(.Cells(Rows.Count, macol + 2).End(xlUp).Row, 2).EntireColumn.Copy Range("a1")
      .Cells(1, macol).Resize(, 4).EntireColumn.Delete
   End With
   MsgBox Format(Timer - deb, "0.0\ sec.")
End Sub

Un exemple du résultat sur mon PC:

 

[Staple1600]

Re, Bonjour mapomme, sylvanu

sylvanu
J'ai paré au plus pressé
J'étais dans VBE d'un oeil pendant que mon oreille droite m'écoutait écrire ma liste de course pour ce midi
Merci d'avoir mis de la tenue dans mon code

=>mapomme
Pourquoi tu me fais du mal?
Tu sais bien que mon vieux bousin est à la peine.
Et que j'en souffre tous les jours un peu plus.
Je vais quand même de faire plaisir et tester ton objet de torture.

 

[Staple1600]

Re

Est-ce que le Timer est fiable?
nbr lignes Log10 (nb Lignes) Durée
10 1 0,10
100 2 8,00
1000 3 6,80
10000 4 7,60
100000 5 10,60
1000000 6 37,60

 

[R@chid]

Bonjour @ tous,
Est-ce que le Timer est fiable?
Staple1600
Oui il est fiable, et ça dépend bien de la bécane utilisée apparemment tu une 7 cylindres de 10ème Génération

 

[mapomme]

10 1 0,10
100 2 8,00
1000 3 6,80
10000 4 7,60
100000 5 10,60
1000000 6 37,60

Il n'y a pas à rougir. Pour l'âge de ton moulin à café, c'est bien (même pas un facteur 10) par rapport à ma bécane.
1 méga de lignes de données, c'est pas courant. Après on passe à Access ou à une autre BDD.

 

[Staple1600]

Re, Bonjour R@chid

Je disais cela
Car 100 lignes= 8 secondes
Et 10 000 lignes 7,6 secondes

Et je viens de faire 5 lignes
=> 7 secondes

????

C'est les vents solaires !!!

 

[sylvanu]

Bonjour tout le monde,
@mapomme,
Je n'ai pas pu m'empêcher de tester nos deux algo à iso périmètre ( même matrice d'entrée ) j'obtiens le graph ci dessous. D'où 2 questions :
1- Jusqu'à 2^15 lignes je suis plus rapide que vous mais au delà je me fait explosé. Je sais que 32768 c'est un integer, mais je ne vois pas le rapport dans mon algo.
2- Vos résultats sont encore plus bizarres. Vous êtes plus rapide à traiter 65000 lignes que d'en traiter 30000 (!)
De plus au delà de 2^16 vous ralentissez. Et là je ne comprends plus.
Une idée ?

PJ : https://www.cjoint.com/c/JLto00asSjY

 

[Staple1600]

Re

Sylvanu

Je n'ai pas pu m'empêcher de tester nos deux algo

Merci de me citer au générique en bas de l'écran, à droite
Sylvanu (sur un décor de Staple)

(Pour les costumes, c'était Roger Hart )

Signé:
Le 3ième larron.

 

[Staple1600]

Re

A l'inverse, ici, je vais plus vite

Spoiler: même si c'est superfétatoire

Sub A_Defaut_De_Supprimer_Je_Remplis_1_peu_plus_vite(Optional Des_lignes_et_des_lignes)
Dim vals, n&, i&, x
vals = Array(Array(11, 12), Array(23, 27), Array(111, 111), Array(327, 121), Array(55, 133), Array(1600, 727), Array(111, 111))
Dim t()
Application.ScreenUpdating = False
Rows("2:100000") = ""
n = InputBox("10, 100, 1000, 10000 ou 100000 ?", "NE SAISIR QUE DES CHIFFRES (1 à 5)", 1) * 1
If n > 5 Then n = 5
nn = 10 ^ n
Randomize 1600
ReDim t(1 To nn, 1 To 2)
For i = 1 To nn
x = Application.RandBetween(1, 6)
t(i, 1) = vals(x)(0)
t(i, 2) = vals(x)(1)
Next
Cells(2, 1).Resize(UBound(t, 1), UBound(t, 2)) = t
End Sub

 

[sylvanu]

Re,
Je ne voulais en aucun cas vous froisser.
L'algo de Mapomme étant le plus rapide des trois surtout sur de grandes matrices, je voulais simplement comprendre ce qui justifiait ce delta avec mon algo.
Uniquement pour m'améliorer, non pour faire de la compétition.
Sorry.