Supprimer quelques centaines de lignes rapidement

Bonjour,

j'ai un fichier Excel (un seul onglet/feuillet) avec environ 1500 lignes. Chaque ligne correspond à un produit. Il y a plusieurs colonnes, notamment la référence du produit, le prix etc etc...

J'ai la liste des références que je souhaite conserver dans ce fichier. Cette liste est située dans une colonne Excel. Une référence par ligne.

Alors, pour bien me faire comprendre, voila ce que j'ai :

1 fichier Excel avec "trop" de produits, que je souhaite alléger.

1 fichier Excel avec une seule colonne contenant les références des produits que je souhaite conserver dans le premier fichier (cité ci-dessus).

Savez-vous si il est possible de faire comprendre à Excel la chose suivante :

Si, dans la colonne "référence" du fichier Excel à modifier, il n'y a pas la référence qui est dans le deuxième fichier (celui avec une seule colonne dedans), alors supprimer la ligne complète.

Merci pour votre aide

Bonne fin de journée !

Bonjour

Afin de tester, il faudrait les 2 fichiers

Salut,

D'accord, je joins ici les deux fichiers exemples. Donc la ce que je souhaite faire, c'est supprimer automatiquement (rapidement) les lignes 2 et 4 du fichier Excel "forum-fichier a modifier.xlsx".

Bonjour à tous

Un essai à tester avec des fichiers fictifs.

Les 2 fichiers doivent être ouverts.

Cela convient-il ?

Bye !

Bonjour,

merci énormément pour ton aide rapide. C'est presque parfait !

La fonction est celle la en tout cas.

Par contre, dans un souci pratique... Est-ce que tu peux supprimer la ligne complète dans le fichier "Fichier A alléger" ? C'est à dire aller jusqu'à la colonne KQ ?

Enfin, peux-tu mettre la colonne Référence dans la colonne A STP ?

Nouvelle version.

Merci.

Je ne comprends pas. Je copie colle dans le fichier à alléger ma liste de produit (avec 36 colonnes). Je clique sur Alléger.

J'ai l'erreur :

Erreur d'exectution '13':

Incompatibilité de type.

Si je clique sur debocage :

Option Explicit

Dim tablo, dico, tabloR(), c, i, j, k

Sub Alleger()

    tablo = Range("A1:KQ" & Range("A" & Rows.Count).End(xlUp).Row)
    Set dico = CreateObject("Scripting.Dictionary")
    On Error GoTo ouvrirFichierRef
    With Workbooks("Ref à conserver.xlsx").Sheets("Feuil1")
        On Error GoTo 0
        For Each c In .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row)
            dico(c.Value) = ""
        Next c
    End With

    k = 0
    For i = 1 To UBound(tablo, 1)
        If dico.exists(tablo(i, 1)) Then
            ReDim Preserve tabloR(UBound(tablo, 2), k + 1)
            For j = 1 To UBound(tablo, 2)
                tabloR(j - 1, k) = tablo(i, j)
            Next j
            k = k + 1
        End If
    Next i
    Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    Range("A2").Resize(UBound(tabloR, 2), UBound(tablo, 2)) = Application.Transpose(tabloR)

Exit Sub

ouvrirFichierRef:
    MsgBox "Le fichier ''Ref à conserver.xlsx'' doit être ouvert.", 16
    End
End Sub

EDIT: je précise que Le fichier ''Ref à conserver.xlsx'' est ouvert.

EDIT2: j'ai renommé ton fichier "Fichier à alléger v2" par "Fichier à alléger".

J'ai fait la même manipulation et j'ai le code suivant suite à mon clique sur débocage:

Sub Alleger()

    tablo = Range("A1:KQ" & Range("A" & Rows.Count).End(xlUp).Row)
    Set dico = CreateObject("Scripting.Dictionary")
    On Error GoTo ouvrirFichierRef
    With Workbooks("Ref à conserver.xlsx").Sheets("Feuil1")
        On Error GoTo 0
        For Each c In .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row)
            dico(c.Value) = ""
        Next c
    End With

    k = 0
    For i = 1 To UBound(tablo, 1)
        If dico.exists(tablo(i, 1)) Then
            ReDim Preserve tabloR(UBound(tablo, 2), k + 1)
            For j = 1 To UBound(tablo, 2)
                tabloR(j - 1, k) = tablo(i, j)
            Next j
            k = k + 1
        End If
    Next i
    Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    Range("A2").Resize(UBound(tabloR, 2), UBound(tablo, 2)) = Application.Transpose(tabloR)

Exit Sub

ouvrirFichierRef:
    MsgBox "Le fichier ''Ref à conserver.xlsx'' doit être ouvert.", 16
    End
End Sub

EDIT 3: Sinon, ce qu'il me reste du côté "graphique" dans "Fichier à alléger" c'est toutes les colonnes (de toutes les lignes) à partir de la colonne L. Sinon, toutes les lignes & colonnes ont été supprimées/vidées de la colonne A à la colonne K. Je précise que dans les cellules que j'ai copiées/collées ou il y a tous mes produits, les colonnes J & K sont vides d'origine.

Deux remarques :

1 - Tu parles de 36 colonnes…

N'as-tu pas dis qu’il fallait aller jusqu’à la colonne KQ ? C’est la colonne 303 !

2 – Que ne m’envoies-tu pas tes vrais fichiers, anonymisés si besoin et en passant par cjoint.com s’ils sont très gros ?

On arriverait plus facilement au résultat.

Bye !

Oui, ça va jusqu'à la colonne KQ, je ne les ai pas compté, c'était pour dire "des tonnes de colonnes".

Je t'envoie un PM dès que c'est UP.

Je t'ai envoyé un MP. Je n'ai plus rien dans ma boite d'envoi, je ne sais pas si c'est normal. Dis moi si tu l'as bien reçu STP.

Bonsoir frank69, gmb, Banzai64, le forum

A adapter à ton cas.

J'ai placé les données sur 2 feuilles dans un même classeur pour l'exemple.

C'est le même principe avec 2 fichiers.

Option Explicit

Sub test()
Dim r As Range, x As Range, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets("Feuil1")
        For Each r In .Range("a1", .Range("a" & Rows.Count).End(xlUp))
            If Not dico.exists(r.Value) Then
                dico(r.Value) = Empty
            End If
        Next
    End With
    With Sheets("Feuil2")
        For Each r In .Range("a1", .Range("a" & Rows.Count).End(xlUp))
            If Not dico.exists(r.Value) Then
                If x Is Nothing Then
                    Set x = r.EntireRow
                Else
                    Set x = Union(x, r.EntireRow)
                End If
            End If
        Next
    End With
    If Not x Is Nothing Then x.Delete
    Set x = Nothing
End Sub

klin89

Hello,

merci pour ton aide

Bon personnellement je connais pas bien les macros avec Excel. Les seules que je connaisse c'est via iMacro (un plugin Chrome ou Firefox).

En tout cas mon prob a été résolu. Merci à vous pour votre rapidité et votre efficacité. Il y a des dingues qui trainent sur ce forum

Bonjour,

je reviens vers vous car je rencontre des problèmes.

Non pas que ça ne fonctionne pas mais je pense qu'il sera bien plus facile pour moi de prendre comme "référence" les titres des produits et pas les références de ceux-ci.

J'ai un fichier avec une seule colonne, qui comporte un certain nombre de titres de produits (un titre de produit par celulle). Cependant, se ne sont pas les titres complets des produits.

J'ai un autre fichier que je souhaite alléger. Dans ce fichier il y a plein de colonnes, et notamment une avec le titre du produit.

Je souhaite que les produits cités dans le premier fichier soient effacés (toute la ligne) du fichier à alléger.

Je vous joint les deux fichiers.

Je précise que le petit problème c'est que les titres des produits qui sont dans le premier fichier ne sont pas complet.

Par exemple dans le premier fichier il y a :

Piscine

Saut

Et dans le fichier à alléger il y a des produits nommés:

Piscine rouge

Piscine bleu

Saut orange

Saut géant

Pomme de pain

surf violet

Et bien l'objectif est de conserver uniquement les lignes avec les produits Pomme de pain & surf violet. Les autres doivent être supprimées.

Pouvez-vous m'aider à nouveau SVP ?

PS: j'ai uploadé le fichier à alléger sur un hébergeur fait pour car il est peut etre trop gros pour ce forum. De plus, dans ce fichier, tout ce passe dans l'onglet "test TXT 7 separateur tab". Voici l'URL pour le telecharger :

Bonjour à tous

Nouvel essai adapté de la macro de Klin89

Bye !

Salut,

merci gmb !

Par contre, lorsque je met le mot "rouge" dans le fichier "A supprimer", ça ne me supprime pas le produit "Piscine rouge".

J'aimerai que ça le fasse car je ne vais pas mettre le titre complet du produit à supprimer, juste une partie.

Nouvelle version à tester :

https://www.cjoint.com/c/FAvm3dAzMHf

Bye !

Merci beaucoup GMB !

J'ai tester sur un petit bout de ma base de données de produits, ça fonctionne nickel.

Cette après midi je test ça plus profondément et je marque le topic comme résolu si no problème

Merci beaucoup pour votre aide à tous !!

Ca marche parfaitement, c'est vraiment le top. Merci beaucoup encore une fois !