Suppression de lignes suivant un contenu

[christ91]

Bonjour,

Voici mon problème, j'ai dans un classeur excel 2 feuilles .

la feuille 1 contient la liste de clients que je veux supprimer de la feuille 2.

Dans ma feuille 2 il peut y avoir plusieurs fois le nom du même client, et c'est là que j'ai un problème.
je n'arrive pas à faire une boucle pour supprimer toutes les lignes contenant c'est clients.

je joints un fichier exemple.

Merci

 

[vgendron]

Re : Suppression de lignes suivant un contenu

Bonjour,

essaie avec ce code

Sub suppress()

    FinListeToSup = Sheets("clients a supprimer").Range("A65536").End(xlUp).Row
    Sheets("liste des clients").Activate
    FinListeATraiter = Sheets("liste des clients").Range("A65536").End(xlUp).Row

For i = 1 To FinListeToSup
    ele = Sheets("clients a supprimer").Range("A" & i)
        
    For j = FinListeATraiter To 1 Step -1
        If Sheets("liste des clients").Range("A" & j) = ele Then Sheets("liste des clients").Range("A" & j).EntireRow.Delete
    Next j
    FinListeATraiter = Sheets("liste des clients").Range("A65536").End(xlUp).Row
Next i
    
 
End Sub

 

[job75]

Re : Suppression de lignes suivant un contenu

Bonjour christ91, vgendron,

Avec un tableau VBA (matrice) c'est plus rapide sur un grand tableau :

Sub SupprimerClients()
Dim F1 As Worksheet, F2 As Worksheet, Asup As Range, t, i&, n&
Set F1 = Feuil1: Set F2 = Feuil2 'CodeNames des feuilles
Set Asup = F1.Range("A1", F1.Range("A" & F1.Rows.Count).End(xlUp))
t = F2.Range("A1", F2.Range("A" & F2.Rows.Count).End(xlUp)(2))
For i = 1 To UBound(t)
  If Application.CountIf(Asup, t(i, 1)) = 0 And t(i, 1) <> "" Then
    n = n + 1
    t(n, 1) = t(i, 1)
  End If
Next
'--restitution du tableau épuré en C1---
If n Then F2.[C1].Resize(n) = t
F2.[C1].Offset(n).Resize(F2.Rows.Count - n) = ""
End Sub

Bien sûr on peut "restituer" sur A1 au lieu de C1.

A+

 

[christ91]

Re : Suppression de lignes suivant un contenu

Bonsoir,

Merci pour les 2 solutions. Je suis impressionné.

Vous pourriez m'expliquer comment fonctionne les instruction for i= 1 ?

Cordialement

 

[job75]

Re : Suppression de lignes suivant un contenu

Bonjour christ91, le forum,

Vous pourriez m'expliquer comment fonctionne les instruction for i= 1 ?

Mettez vous dans VBA (Alt+F11), appuyez sur la touche F1 et tapez le mot clé For.

Maintenant si vous voulez voir mettez dans un module quelconque :

Sub a()
Dim i As Byte, x
For i = 1 To 5 'Step 1
  x = i
Next
MsgBox i
End Sub

Sub a_bis()
Dim i As Byte, x
For i = 1 To 5 Step 2
  x = i
Next
MsgBox i
End Sub

Sub b()
Dim i As Integer, x
For i = 5 To 1 Step -1
  x = i
Next
MsgBox i
End Sub

Sub b_bis()
Dim i As Integer, x
For i = 5 To 1 Step -2
  x = i
Next
MsgBox i
End Sub

Pour exécuter chaque macro, placez le curseur devant Sub, menu Débogage => Pas à pas détaillé et appuyez sur F8.

A chaque pas mettez le curseur sur i pour voir sa valeur.

Il est intéressant de noter que dans les boucles la ligne du For n'est exécutée qu'une fois.

Bonne journée.

 

[laetitia90]

Re : Suppression de lignes suivant un contenu

bonjour tous
peut être passer par un dico & tablo plus rapide sur une grande plage???

Sub es()
Dim t(), t1(), t2(), i As Long, x As Long, s As Long, m As Object
Set m = CreateObject("Scripting.Dictionary")
t2 = Feuil1.Range("a1:a" & Feuil1.Cells(Rows.Count, 1).End(3).Row)
t = Feuil2.Range("a1:a" & Feuil2.Cells(Rows.Count, 1).End(3).Row)
For i = 1 To UBound(t2)
If Not m.Exists(t2(i, 1)) Then m.Add t2(i, 1), t2(i, 1)
Next i
ReDim t1(1 To UBound(t), 1 To 1)
x = 1
For i = 1 To UBound(t)
If Not m.Exists(t(i, 1)) Then t1(x, 1) = t(i, 1): x = x + 1
Next i
Feuil2.[b1].Resize(UBound(t1), 1) = t1
Erase t, t1, t2: Set m = Nothing
End Sub

 

[job75]

Re : Suppression de lignes suivant un contenu

Bonsoir Laetitia,

Tu as tout à fait raison, ta solution est encore bien plus rapide.

J'ai testé sur 2 tableaux identiques de 10000 lignes, sans doublons :

job75 => 15 secondes

Laetitia => 0,12 seconde

Bonne soirée.

Edit : avec en Feuil1 3 lignes et en Feuil2 10000 lignes, toujours sans doublons :

job75 => 0,19 seconde

Laetitia => 0,06 seconde.

A+

 

[christ91]

Re : Suppression de lignes suivant un contenu

Bonjour Laetitia,

j'ai une erreur en exécutant ton script sur cette ligne:

t2 = Feuil1.Range("a1:a" & Feuil1.Cells(Rows.Count, 1).End(3).Row)

saurais-tu pourquoi ?


Merci

 

[laetitia90]

Re : Suppression de lignes suivant un contenu

re tous
chez moi ca marche avec ton fichier ??? je le met
tu as forcement une feuil1.... code_name.... c'est quoi l'erreur ???

autrement si trés peu de lignes code pas forcement utile a mon avis!!

 

[christ91]

Re : Suppression de lignes suivant un contenu

j'ai une erreur 13
incompatibilité de script

en fait la macro fonctionne bien dans le fichier que tu as envoyé, mais ne fonctionne pas lorsque je l’exécute à partir à partir de mon classeur de macro personnalisées.


j'ai un fichier de 162398 lignes à traiter.....

merci de votre aide

 

[Staple1600]

Re : Suppression de lignes suivant un contenu

Bonsoir à tous,

Salut leti, job75


Pour information (et pour varier les plaisirs)
(une solution exploitable pour une suppression pour une petite liste de clients à supprimer)
En utilisant le filtre élaboré
(en réagençant la liste de critère comme ci-dessous)

 

[job75]

Re : Suppression de lignes suivant un contenu

Bonjour christ91, Laetitia, [Edit] salut JM,

Les CodeNames Feuil1 et Feuil2 ne peuvent être que des feuilles du classeur contenant la macro.

Pour utiliser la macro sur un autre classeur il faut les Names des feuilles :

Sub es()
Dim t(), t1(), t2(), i As Long, x As Long, s As Long, m As Object
Set m = CreateObject("Scripting.Dictionary")
With ActiveWorkbook.Sheets("NomFeuille1") 'nom à adapter
  t2 = .Range("a1:a" & .Cells(.Rows.Count, 1).End(3).Row)
End With
With ActiveWorkbook.Sheets("NomFeuille2") 'nom à adapter
  t = .Range("a1:a" & .Cells(.Rows.Count, 1).End(3).Row)
  For i = 1 To UBound(t2)
  If Not m.Exists(t2(i, 1)) Then m.Add t2(i, 1), t2(i, 1)
  Next i
  ReDim t1(1 To UBound(t), 1 To 1)
  x = 1
  For i = 1 To UBound(t)
  If Not m.Exists(t(i, 1)) Then t1(x, 1) = t(i, 1): x = x + 1
  Next i
  .[b1].Resize(UBound(t1), 1) = t1
End With
Erase t, t1, t2: Set m = Nothing
End Sub

Adaptez les noms "NomFeuille1" et "NomFeuille2".

PS : vous auriez pu accuser réception de mon post #5, non ?

A+

 

[job75]

Re : Suppression de lignes suivant un contenu

Re,

Dans un classeur de macros personnelles ceci sera mieux car ne nécessite pas d'adaptation :

Sub es()
Dim t(), t1(), t2(), i As Long, x As Long, s As Long, m As Object
Set m = CreateObject("Scripting.Dictionary")
With ActiveWorkbook.Sheets(1) '1ère feuille du classeur actif
  t2 = .Range("a1:a" & .Cells(.Rows.Count, 1).End(3).Row)
End With
With ActiveWorkbook.Sheets(2)  '2ème feuille du classeur actif
  t = .Range("a1:a" & .Cells(.Rows.Count, 1).End(3).Row)
  For i = 1 To UBound(t2)
  If Not m.Exists(t2(i, 1)) Then m.Add t2(i, 1), t2(i, 1)
  Next i
  ReDim t1(1 To UBound(t), 1 To 1)
  x = 1
  For i = 1 To UBound(t)
  If Not m.Exists(t(i, 1)) Then t1(x, 1) = t(i, 1): x = x + 1
  Next i
  .[b1].Resize(UBound(t1), 1) = t1
End With
Erase t, t1, t2: Set m = Nothing
End Sub

A+

 

[christ91]

Re : Suppression de lignes suivant un contenu

j'ai oublié il faut que je supprime les clients, et toutes les colonnes qui sont sur la droite
mes clients sont rangés par ligne, et dans les colonnes à côté j'ai les adresses, telephone....etc.

l’idéal serai que ta macro permette une recopie les clients à converser dans une feuil3 ligne par ligne avec toutes les colonnes.

est-ce possible d'adapter ton code ?

 

[job75]

Re : Suppression de lignes suivant un contenu

Re,

Un peu sans gêne non ? Même pas bonjour ou bonsoir...

A+