Comparer cellules en A a col en B et supprimer en A ce qui n'est pas en B

Bonsoir a tous, je me tortille depuis hier pour trouver comment faire, mais hélas je jette l’éponge, je bug, mais bien ..

pour faire simple :
un fichier A avec des cellules contenant des données multiples séparées par des virgules.
un fichier B contenant des données sur une colonne avec une donnée par cellule.

Il faut comparer "les données" dans les cellules du fichier A colonne "TYPE_serie" avec l'unique colonne du fichier B , et supprimer "les données des cellules dans A colonne "TYPE_serie" ne se trouvant pas dans le fichier B"

1000 merci a tous

12b-type.xlsb (264.02 Ko)

Bonjour

Supprimer les lignes ou bien supprimer dans la chaîne les valeurs non trouvées ?

Et dans le second cas, quid des lignes où ne reste aucun TYPE_serie ?

Bonsoir,

premier jet :

Attention ! Pas rapide ! Je passe par des Range, il faudrait passer par des tableaux ! Résultat de la suppression en feuille 2, si pas de valeur alors une cellule vide affichée.

@ bientôt

LouReeD

Bonsoir,

une version "100%" VBA avec l''aide d'un dictionnaire afin de travailler sans doublon au niveau de la liste de la colonne unique du fichier B, et en plus l'instruction "Existe" du dictionnaire est plus rapide que le "Find".
Donc les valeur du fichier A, sont mises dans un tableau VBA, les valeurs du fichier B sont mises dans un dictionnaire.
Chaque valeur du fichier A lors de la boucle sur la taille de ce tableau sont "splitées" avec la virgule, ce qui nous donne un tableau des valeur contenues dans la cellule.
On test si chacune de ces valeurs existent ou pas dans le dictionnaire.
Si elle existe on l'inscrit dans le tableau de sortie TabloS.

On crée ensuite une valeur string "Temp" qui est la concaténation de ce tableau de sortie avec les virgules.

La valeur de la colonne A est ensuite inscrite dans un tableau résultat, et la valeur Temp est inscrite également sur ce tableau. On boucle sur la valeur de cellule du fichier A suivante.

à la fin on inscrit le tableau résultat sur la feuille 2 à partir de la cellule A2.

Le code :

Option Explicit

Sub TrouveEtEfface()
    Application.ScreenUpdating = False
    Dim MonDico As New Scripting.Dictionary
    Dim Tablo, TabloS(), Tab_Résultat()
    Dim ColonneA, ColonneB As Range, I, J, K, Trouve As Range, Tmp As Variant
    Dim Temp As String, Cpt, Cpt2
    ColonneA = ActiveSheet.Range("B2:B8178").Value
    For I = 2 To 40120
        If Not MonDico.Exists(Workbooks("b-type.xlsb").Sheets("Feuil1").Cells(I, 1)) Then
            MonDico.Add "_" & Workbooks("b-type.xlsb").Sheets("Feuil1").Cells(I, 1), Workbooks("b-type.xlsb").Sheets("Feuil1").Cells(I, 1)
        End If
    Next I
    Cpt = 0
    Cpt2 = 0

    For J = 0 To Ubound(ColonneA,1)-1
        Tablo = Split(ColonneA(J + 1, 1), ",")
        For K = 0 To UBound(Tablo)
            If MonDico.Exists("_" & Evaluate(Tablo(K) * 1)) Then
                ReDim Preserve TabloS(Cpt + 1)
                TabloS(Cpt) = Tablo(K)
                Cpt = Cpt + 1
            End If
        Next K

        On Error Resume Next
            Tmp = UBound(TabloS)
        On Error GoTo 0

        If Not IsEmpty(Tmp) Then
            For I = 0 To UBound(TabloS) - 1
                Temp = Temp & TabloS(I) & ","
            Next I
            Temp = Mid(Temp, 1, Len(Temp) - 1)
        Else
            Temp = ""
        End If
        ReDim Preserve Tab_Résultat(1, Cpt2 + 1)
        Tab_Résultat(0, Cpt2) = Feuil1.Cells(J + 2, 1).Value
        Tab_Résultat(1, Cpt2) = Temp

        Erase TabloS
        Erase Tablo
        Cpt = 0
        Cpt2 = Cpt2 + 1
        Temp = ""
        Tmp = Empty
    Next J
    Feuil2.Activate
    Range("A2").Resize(UBound(Tab_Résultat, 2), 2) = Application.Transpose(Tab_Résultat)
End Sub

Il peut, peut-être plus simple...

Le fichier :

Attention, pour l'analyse complète il faut changer le "compteur" final de la boucle J et il faut que les deux fichiers se trouvent au même endroit et qu'il soient ouverts.
Il y a aussi un test sur le fait que le TabloS soit vide ou pas afin d'éviter une erreur de code, et si le cas se présente alors une cellule vide (Temp="") sera inscrite en face de l'intitulé de la colonne A.

Il faut aussi activer le module VBA Microsoft Scripting Runtime, pour le dictionnaire :

sans titre

@ bientôt

LouReeD

Bonjour

Une version PowerQuery : changer le chemin d'accès sur Feuil3 puis Données, Actualiser tout

Edit : si on ajoute l'ouverture du second fichier au code de LouReed, les temps sont quasi identiques avec un très léger avantage à PowerQery (1,59s et 1,70s)

Donc 2 solutions équivalentes sur le volume actuel

Bonjour , merci pour les 2 methodes, et pour le temps que vous y avez consacré

j'ai bien suivi les instructions pour activer le module VBA Microsoft Scripting Runtime et ouvert les 2 fichiers sous le mème répertoire

ça tourne mais j'ai un message d'erreur Erreur d'execution 13

apparemment c'est sur cette ligne que ca bloque qui reste en fluo

le debogueur vas sur Range("A2").Resize(UBound(Tab_Résultat, 2), 2) = Application.Transpose(Tab_Résultat)

je sais utiliser une macro mais pas au point de savoir modifier , désolé

j'ai utilisé la macro du fichier et aussi, celle que j'ai copié d'ici , meme resultat

on s'arrete au meme endroit

capture erreur1

La solution de Chris78 , en mettant le lien du fichier la ou il est sur mon pc, et en rafraichissant,

j'ai essayé en effaçant les résultats qui y étaient déjà sur la feuille 2, ( merci, ca m'a permis d'avancer sur mon travail )

car cette solution est importante pour moi car je dois modifier ces données chaque mois

ca tourne, mais meme résultat, j'ai un message

capture erreur 2

dés que je met ok tout s’arrête

désolé de vous embêter, je suis géné, car je sais que c'est du boulot et du temps

en vous remerciant

Bonjour,

tester ce jour avec les deux fichiers joints en archive, pas de message d'erreur et un peu moins d'une minute pour le résultat :

4desktop.zip (572.55 Ko)

@ bientôt

LouReeD

Bonjour, merci pour le retour

a l'instant

ouverture des 2 fichiers dans le meme répertoire, bien verifier que dans reference Scripting Runtime est activé

et j'ai cliqué sur le gros bouton "allons-y"

même erreur

capture erreur excel

je suis sous windows7 , j'essaierai demain sur un window10 ou une autre machine, il n'y a pas de raison pour que cela ne fonctionne pas,

désolé pour le chmilblik

mille merci

Avez vous lancé la procédure avec la fenêtre VBA ouverte ?

Si oui essayez en fermant cette fenêtre... Qui sait ?...

@ bientôt

LouReeD

Bonjour

La solution de Chris78 , en mettant le lien du fichier la ou il est sur mon pc, et en rafraichissant,

j'ai essayé en effaçant les résultats qui y étaient déjà sur la feuille 2, ( merci, ca m'a permis d'avancer sur mon travail )

car cette solution est importante pour moi car je dois modifier ces données chaque mois

ca tourne, mais meme résultat, j'ai un message

capture erreur 2

Tu as effacé avant ? Il ne faut pas toucher au tableau résultat, il s'adapte automatiquement quand tu actualises

J'ai testé sur 2 PC et 2 versions Excel : je n'ai pas le message d'erreur.

Fais les réglages et tests suivants :

  1. Dans Excel, Données, Connexions : pour chacune des connexions, Requête feuill1, Requête Tableau1, Propriétés, décocher Activer l'actualisation en arrière plan
  2. Dans PowerQuery
    1. dérouler le bouton à l'extrême gauche (Avant Accueil) : Options et paramètres, Options de requête, dans la partie Global, Confidentialité : cocher Toujours ignorer les paramètres de niveau de confidentialité
    2. Vérifie que la requête Feuil1 n'apparait pas avec une erreur (utiliser Accueil, Actualiser l'aperçu si nécessaire), puis même chose sur la requête Tableau1. S'il y a une erreur, passe, dans la liste de droite listant les étapes de la requête, sur chaque étape afin de voir quelle étape pose problème et dis-moi

Bonjour, tésté sur un carbon X1 i7 en win10 office pro plus 2016,

la macro meme message d'erreur ala fin

la versions PowerQuery , sans faire aucune modif, en effaçant complétement les anciens résultats sur la feuille 2, il a mis 51 secondes pour tout traiter, pour 8178 lignes c'est maaaaagique.

j'ai essayé pour voir un fichier avec 29766 lignes il a mis 3 minutes 46

c'est top,

merci infiniment a LouReeD et Chris pour le temps passé sans vous je serais encore a faire du convertir, copier coller vertical et recherche v bref de quoi voir la vie filer entre ces yeux

je suis content,

merci encore

Bonjour,

C'est à ni rien comprendre... Par contre piwerquery sur votre machine fait pas tellement mieux que le code VBA sur ma machine de 2013 ! Je suis rassuré de ce côté.

Qu'est ce qui cloche dans la copie du tableau sur la feuille ? Car avec votre machine on devrait être plus rapide, c'est bien dommage...

Merci pour les remerciements.

@ bientôt

LouReeD

Bonjour

C'est à ni rien comprendre... Par contre piwerquery sur votre machine fait pas tellement mieux que le code VBA sur ma machine de 2013 ! Je suis rassuré de ce côté.

Tu ne comptes pas le temps d'ouverture du fichier : si tu ajoutes l'ouverture au code VBA, les 2 solutions sont très similaires...

Ce sont 2 bonnes solutions et selon le volume de données, l'une ou l'autre peut être plus véloce.

Cela laisse le choix à samexcel que je remercie du retour

Oui en effet, mais de mon coté, j'ai cette impression que PQ (?!) est plus rapide, mais je n'ai pas intégré son fonctionnement.
Sauf erreur de ma part, ce sont une série d'action enregistrées comme un Script, non ?

Après cela n'explique pas l'erreur... La voyez vous ?

@ bientôt

LouReeD

Rechercher des sujets similaires à "comparer col supprimer qui pas"