[résolu] Suppression lignes en fonction d'une liste (VBA)

[nounbxl76]

(Re)Bonsoir,

En + de mon problème de filtre élaboré, j’ai un problème de suppression de lignes via VBA sur un autre fichier…

Je m’explique… sur ma 1ère feuille du fichier joint, j’ai un certain nombre de lignes.

J’aimerais supprimer les lignes dont la valeur en colonne B ne figure pas dans la liste située en feuille 2 mais je suis paumé (et nul en excel 🙁).

Merci encore pour votre aide.

 

[DoubleZero]

Bonjour, nounbxl76, le Forum,

Comme ceci ?

Option Explicit
Sub Ligne_supprimer()
    Dim c As Range, i As Long
    Application.ScreenUpdating = False
    Sheets("Feuil1").Activate
    For i = Cells(Rows.Count, "b").End(xlUp).Row To 3 Step -1
        Set c = Sheets("Feuil2").Columns(1).Find(Range("b" & i).Value)
        If c Is Nothing Then Rows(i).Delete
    Next i
    Application.ScreenUpdating = True
End Sub

A bientôt 🙂

 

[nounbxl76]

Merci pour votre aide DoubleZero.
Je dois être vraiment nul car je n’ai pas réussi à faire fonctionner la macro après l’avoir intégrée 😕

 

[DoubleZero]

Re-bonjour,

Le code doit être logé dans un module standard, comme dans le fichier joint.

A bientôt 🙂

 

[nounbxl76]

Merci encore. C'est tout bon !
M

 

[job75]

Bonjour nounbxl76, DoubleZero,

S'il y a beaucoup de lignes il est indispensable d'utiliser le Dictionary et un tableau VBA :

Sub supprimerLignes()
Dim t, d As Object, tablo, i&, col%, n&
t = Timer
Application.ScreenUpdating = False
'---liste du Dictionary---
Set d = CreateObject("Scripting.Dictionary")
tablo = Sheets("Feuil2").[A1].CurrentRegion.Resize(, 2) 'au moins 2 éléments
For i = 2 To UBound(tablo)
  d(tablo(i, 1)) = ""
Next
If d.Count = 0 Then Exit Sub
'---traitement du tableau---
With Sheets("Feuil1").[A1].CurrentRegion
  col = .Columns.Count + 1 'colonne auxiliaire
  .Columns(col) = "a"
  tablo = .Resize(, col)
  For i = 2 To UBound(tablo)
    If Not d.exists(tablo(i, 2)) Then tablo(i, col) = 1: n = n + 1
  Next
  .Columns(col) = Application.Index(tablo, , col) 'restitution
  .Resize(, col).Sort .Columns(col), xlDescending 'tri pour accélérer (les 1 sont en bas)
  If n Then .Columns(col).SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete
  .Columns(col) = ""
  With .Parent.UsedRange: End With 'actualise les barres de défilement
End With
MsgBox n & " lignes supprimées en " & Format(Timer - t, "0.00 \s")
End Sub

Edit : ici la recherche respecte la casse, si l'on veut que la casse soit ignorée ajouter une ligne :

Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée

Fichier joint avec 64 000 lignes.

A+

 

[nounbxl76]

Merci pour cette contribution job75.
Bonne journée