Comprarer deux colonnes
Résolu
redneo01
Messages postés
12
Statut
Membre
-
Kuartz Messages postés 852 Date d'inscription Statut Membre Dernière intervention -
Kuartz Messages postés 852 Date d'inscription Statut Membre Dernière intervention -
Bonjour mes amis,
Est ce quelqu'un peut m'aider pour un problème que j'arrive pas à résoudre en vba SVP.
Alors je m'explique:
J'ai une colonne A et une colonne B, dans la colonne A j'ai une gare et dans la colonne B j'ai une origine/destination. Je voudrais vérifier ligne par ligne si la destination est la même que la gare alors je supprime.
Par exemple: si la cellule B3 contient une partie de la cellule A3 alors je supprime.
j'ai essayé d'utiliser l'opérateur Like mais j'ai pas réussi:
Je vous joins le fichier pour mieux comprendre:
http://www.cjoint.com/c/EJbhPTaYhNH
Désolé si je m'explique mal mais si quelqu'un pourrais m'aider ça serait super gentil de sa part.
Merci d'avance.
Est ce quelqu'un peut m'aider pour un problème que j'arrive pas à résoudre en vba SVP.
Alors je m'explique:
J'ai une colonne A et une colonne B, dans la colonne A j'ai une gare et dans la colonne B j'ai une origine/destination. Je voudrais vérifier ligne par ligne si la destination est la même que la gare alors je supprime.
Par exemple: si la cellule B3 contient une partie de la cellule A3 alors je supprime.
j'ai essayé d'utiliser l'opérateur Like mais j'ai pas réussi:
x = ActiveSheet.UsedRange.Rows.Count
For j = 3 To x
If Cells(j, 2).Value Like "*" & Cells(j, 1).Value & "*" Then Rows(j).EntireRow.Delete
Next j
Je vous joins le fichier pour mieux comprendre:
http://www.cjoint.com/c/EJbhPTaYhNH
Désolé si je m'explique mal mais si quelqu'un pourrais m'aider ça serait super gentil de sa part.
Merci d'avance.
4 réponses
-
Bonjour,
Essaie cette macro :Sub supprim() x = ActiveSheet.UsedRange.Rows.Count On Error Resume Next For j = x To 3 Step -1 r = 0 ' recherche du premier / dans B n = Application.WorksheetFunction.Search("/", Range("B" & j)) ' prend les 16 premières lettres de A nom = Left(Range("A" & j), 16) ' recherche ces 16 lettres dans B après le / r = Application.WorksheetFunction.Search(nom, Mid(Range("B" & j), n)) ' si correspondance suppression ligne If r > 0 Then Rows(j).EntireRow.Delete Next End Sub
Cdlmnt
Via
-
Merci bcp pour ta proposition, le probleme c'est que dans la colonne B dès fois le mot n'est pas identique, par exemple il se peut qu'il manque un S du coup ton code quand je l'exécute il m'efface une partie.
- En principe ça fonctionne, du moins sur le tableau que tu as mis en exemple
1) tu cherches la destination, elle se trouve en B après le 1er /; la recherche ne se fait que dans cette partie
r = Application.WorksheetFunction.Search(nom, Mid(Range("B" & j), n))
2) en B les noms sont tronqués après la 16eme lettre, c'est pourquoi on relève d'abord dans nom les 16 premières lettres en A et c'est ces 16 lettres qu'on recherche
exemple pour CHALONS-EN-CHAMPAGNE on recherche CHALONS-EN-CHAMP, une seule correspondance est trouvée en ligne 21
Ou alors il y a des cas que tu n'as pas donné dans ton tableau exemple
Quels seraient les effacements erronés ou les effacements qui ne se font pas ?
-
-
Et si tu essaye un truc du genre :
Sub TEST() Dim DL As Long DL = Cells(Application.Rows.Count, 1).End(xlUp).Row For i = DL To 2 Step -1 If Left(CStr(Range("A" & i).Value), 5) Like "*" & Range("B" & i).Value & "*" Then Rows(i).Delete Next i End Sub
Ca donne quoi?-
Merci les gars ça marche pour les deux solutions. c'est super gentil de votre part.
J'en profite pour poser une petite question:
La macro est longue pour l'exécution donc j'ai rajouté une progressbar, le problème ma progress bar elle veut pas s'afficher. d'habitude dans un fichier xls ça marche normal mais pour cette macro, c'est une macro complémentaire (.xla).
Est ce qu'on peut rajouter une progress bar quand c'est une macro complémentaire (.xla) ? -
Bonjour,
Regarde https://www.excel-pratique.com/fr/astuces_vba/progress_bar.php
Par contre, franchement pour ce qui est de la macro complémentaire j'en sais vraiment rien. Essaye, si ça ne marche pas alors c'est que tu ne peux pas.
-
-
Bonjour,
Sinon petite triche, mais dans le cas présent, ça marcherait plutôt pas mal.
Sub TEST() Dim DL As Long DL = Cells(Application.Rows.Count, 1).End(xlUp).Row For i = DL To 2 Step -1 If Left(CStr(Range("A" & i).Value), 5) = Left(CStr(Range("B" & i).Value), 5) Then Rows(i).Delete Next i End Sub
Cordialement. -
Merci pour ta proposition mais le problème c'est que dans la colonne B des fois le mot est situé au milieu des fois a gauche. du coup ça m'efface pas tout le temps.
