Comprarer deux colonnes

Résolu/Fermé
redneo01 Messages postés 12 Date d'inscription lundi 20 juillet 2015 Statut Membre Dernière intervention 1 octobre 2015 - 1 oct. 2015 à 09:44
Kuartz Messages postés 850 Date d'inscription vendredi 13 février 2015 Statut Membre Dernière intervention 15 février 2019 - 2 oct. 2015 à 08:41
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:


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

via55 Messages postés 14495 Date d'inscription mercredi 16 janvier 2013 Statut Membre Dernière intervention 7 novembre 2024 2 734
1 oct. 2015 à 11:02
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
1
redneo01 Messages postés 12 Date d'inscription lundi 20 juillet 2015 Statut Membre Dernière intervention 1 octobre 2015
1 oct. 2015 à 11:10
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.
0
via55 Messages postés 14495 Date d'inscription mercredi 16 janvier 2013 Statut Membre Dernière intervention 7 novembre 2024 2 734 > redneo01 Messages postés 12 Date d'inscription lundi 20 juillet 2015 Statut Membre Dernière intervention 1 octobre 2015
1 oct. 2015 à 11:44
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 ?
0
Kuartz Messages postés 850 Date d'inscription vendredi 13 février 2015 Statut Membre Dernière intervention 15 février 2019 61
1 oct. 2015 à 14:54
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?
1
redneo01 Messages postés 12 Date d'inscription lundi 20 juillet 2015 Statut Membre Dernière intervention 1 octobre 2015
1 oct. 2015 à 16:05
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) ?
0
Kuartz Messages postés 850 Date d'inscription vendredi 13 février 2015 Statut Membre Dernière intervention 15 février 2019 61
2 oct. 2015 à 08:41
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.
0
Kuartz Messages postés 850 Date d'inscription vendredi 13 février 2015 Statut Membre Dernière intervention 15 février 2019 61
1 oct. 2015 à 10:14
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.
0
redneo01 Messages postés 12 Date d'inscription lundi 20 juillet 2015 Statut Membre Dernière intervention 1 octobre 2015
1 oct. 2015 à 10:29
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.
0