Recherche paires et efface

[Atiom]

Bonjour

Je cherche à faire la chose suivante :
Trouver la dernière ligne remplies de la colonne B
Vérifier si elle est égale à la dernière ligne de la colonne A

Si oui alors effacer le contenue des deux cellules trouves. (colonne A et B ) et recommencer l’opération.

Cas contraire passer é la ligne suivante de la colonne A et procéder de la même manière.

Et ainsi de suite jusque à la dernière cellule remplie.
Si une lettre de la colonne B n’est pas trouvé dans la colonne A alors afficher 1 dans la colonne C et passer à la ligne suivante.

Je mets un fichier joint avec le résultat souhaité dans la colonne C.


Merci

 

[Papou-net]

Re : Recherche paires et efface

Bonsoir Atiom,

Si j'ai bien compris la question, la macro ci-dessous devrait y répondre :

Sub Recherche()

' Déclaration des variables
    Dim DernièreLigne_B As Long
    Dim DernièreLigne_A As Long
    Dim Lg As Long

    'En partant de la derniere ligne de la colonne B monter jusqu'à la prochaine cellule pleine
    DernièreLigne_B = Range("B65536").End(xlUp).Row
    For Lg = DernièreLigne_B To 2 Step -1
      DernièreLigne_A = Range("A65536").End(xlUp).Row
      If Cells(Lg, 2) = Cells(DernièreLigne_A, 1) Then
        Cells(Lg, 2).Delete Shift:=xlUp
        Cells(Lg, 3).Delete Shift:=xlUp
        Cells(DernièreLigne_A, 1).Delete Shift:=xlUp
        Else
        Cells(Lg, 3) = 1
      End If
    Next
    
End Sub

Espérant avoir répondu.

Cordialement.

 

[Atiom]

Re : Recherche paires et efface

Bonjour le forum

Merci beaucoup Papou-net.🙂

Je crois qu’on est sur le bon chemin.
Mais il y a encore quelque chose à modifier.
Dés que la macro trouve deux lettres que ne forment pas de paire elle bug.

Regardez dans la pièce joint.

J’ai essaye de la modifier mas sans sucées.
Alors si quelqu’un à une idée de comment peut-on contourner le problème ça serait sympa.

Merci

 

[Papou-net]

Re : Recherche paires et efface

Bonjour le forum

Merci beaucoup Papou-net.🙂

Je crois qu’on est sur le bon chemin.
Mais il y a encore quelque chose à modifier.
Dés que la macro trouve deux lettres que ne forment pas de paire elle bug.

Regardez dans la pièce joint.

J’ai essaye de la modifier mas sans sucées.
Alors si quelqu’un à une idée de comment peut-on contourner le problème ça serait sympa.

Merci

Bonjour Atiom,

En modifiant le code comme ci-dessous, ça devrait répondre à ta demande.

Sub Recherche()

' Déclaration des variables
    Dim DernièreLigne_B As Long
    Dim DernièreLigne_A As Long
    Dim Lg As Long

    'En partant de la derniere ligne de la colonne B monter jusqu'à la prochaine cellule pleine
    DernièreLigne_B = Range("B65536").End(xlUp).Row
    For Lg = DernièreLigne_B To [COLOR="Red"][B]3[/B][/COLOR] Step -1
      DernièreLigne_A = Range("A65536").End(xlUp).Row
      If Cells(Lg, 2) = Cells([COLOR="Red"][B]Lg[/B][/COLOR], 1) Then
        Cells(Lg, 2).Delete Shift:=xlUp
        Cells(Lg, 3).Delete Shift:=xlUp
        Cells([COLOR="Red"][B]Lg[/B][/COLOR], 1).Delete Shift:=xlUp
        Else
        Cells(Lg, 3) = 1
      End If
    Next
    
End Sub

Bonne journée.

Cordialement.

 

[Atiom]

Re : Recherche paires et efface

Bonjour

Effectivement ça fonctionne.
Par rapport à ce que j’ai demandé au départ ça me convient. Merci Papou-net.🙂

Je me demande si ont peut aller plus loin, ça serait super, d'obtenir le même résultat avec les lignes décalées. La macro actuelle ne le fait pas.

Je remets une pièce jointe avec les lignes décales, ça serait super, si quelqu’un trouve la solution.

Cas contraire, encore une fois merci beaucoup Papou-net pour ta solution.

 

[Atiom]

Re : Recherche paires et efface

Bonjour le forum

Je relance le post, tout simplement parce que je me suis rendu compte que dans certains cas la solution donné par Papou-Net ne fonctionne pas.

Contrairement à ce que je pensé avant. Je pensais que ça suffisais… mais non.
Comme la macro s’arrête des que les lignes sont décalées, je suis à la recherche d’une solution, décrite dans la dernière pièce jointe.
Lien supprimé

D’autre idées, par tri, comparaison ( VBA ou formules sont les biens venus )

Merci de votre aide

 

[pierrejean]

Re : Recherche paires et efface

Bonjour Atiom

Vois si cela te convient

 

[Atiom]

Re : Recherche paires et efface

Bonsoir le fil

Bonjour Pierre, grand plaisir de te croiser à nouveau sur un fil.🙂

A partir de ta proposition, j’ai fait un petit fichier avec des explications un peu plus détaillées.

Concrètement il s’agit de comparer deux mots et trouver les différences.
Avec quelques astuces pour extraire les caractères et supprimer les espaces, ces deux mots se retrouvent dans la colonne A et B comme dans l’exemple.

J’ai testé ta proposition, merci beaucoup, elle est presque parfaite.
Il y a deux trois choses à perfectionner.

Je sais que ne sont pas de petites choses, mais pas impossibles à contourner.
Alors si tu as un moment, au quelqu’un d’autre dans le forum, que puisse donner un coup d’œil et trouver la solution ça serait sympa.

Merci à tous pour votre aide .

 

[pierrejean]

Re : Recherche paires et efface

Salut Francis

Heureux egalement de te croiser (y a toujours pas le feu au lac ?)

Un tantinet tiré par les cheveux mais je crois que cela fonctionne
Veux-tu tester ?

 

[Atiom]

Re : Recherche paires et efface

Salut Pierre

Merci infiniment🙂

Non il n’y pas le feu au lac, il faut dire que avec ce temps…
J’ai testé le fichier et même tiré par les cheveux je suis toujours impressionné.

Ça fonctionne dans tous les cas sauf 1.

Lorsque il y a les mêmes caractères mais dans le désordre.

Exemple ( chien, niche ).

J’ai une petite idée pour contourner le problème.

Ajouter à la macro une formule pour vérifier la bonne réponse, du type.

Si Nombre total d'erreurs est égal à 0, aller vérifier que les caractères de la colonne A et B sont identiques.

Des que possible je mets le fichier, mais si tu as une autre idée.

Au plaisir de te lire.

 

[pierrejean]

Re : Recherche paires et efface

Re

En attendant ton fichier voici une version moins capillotractée
pour les anagrammes j'y reflechi mais ce n'est pas gagné !!!

 

[Atiom]

Re : Recherche paires et efface

Re,

Merci de ta version moins capillotractée, impressionnant la facilité que t'as à rendre les choses simples.

Moi j’ai réfléchi pour les anagrammes et voila se que j’ai trouvé.
J’ai ajouté une colonne pour tester la bonne réponse.

Et j’envoie une formule =SI(ET(C$2+D$2=0;NON(EXACT(A3;B3)));1;0)
En VBA j’ai ajouté le code ci-dessous à la fin de ta macro.

Next
[COLOR="SeaGreen"] 'Test bonne réponse[/COLOR]
     Range("E3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(R2C[-2]+R2C[-1]=0,NOT(EXACT(RC[-4],RC[-3]))),1,0)"
    Range("E3").Select
    Selection.AutoFill Destination:=Range("E3:E52"), Type:=xlFillDefault
    Range("E3:E52").Select
    Range("A1").Select

Et le tour est joué ! Nous pouvons comparer deux mots dans tous les sens le nombre d’erreurs s’affiche correctement.

Je mets le fichier, regarde si tu arrives à faire plus simple !

Cas contraire pour l’instant je suis satisfait. (Si j’ai bien testé toutes les possibilités !!! ).

Encore grand merci et au plaisir de croiser sur un autre fil. 🙂

EDITION:
Tu as raison, ce n’est pas gagné ! Il ne faut pas se réjouir trop vite.
Je viens de voir qu’il reste à traiter le cas des anagrammes (addition et soustraction de caractères).
Mais il est tard, on laisse ça pour demain …