Discussion :

[jpvba]

Tu es vraiment géniale ...

vraiment WOW !!!

Je t'adule !!!

les premiers test SONT VRAIMENT concluant !!! je continu de l'utiliser mais a présent on frôle la perfection si ce n'est pas le cas !!!!

Par contre il n'y a plus le souci de l'ordre des mots féminins, des pluriels et des singuliers.

Également, maintenant je peux classer mon "data" par ordre alphabétique qui est vraiment pratique !!!

Si je comprend bien la sub va commencer a remplacer par les mots composé et par la suite les seuls ???


vraiment Marc mille fois merci !!!

[Marc-L]

Oui cette procédure commence à traiter comme la première démonstration
la colonne E avec l'intégralité de la source puis chaque mot restant avec la colonne A …

[jpvba]

hmm je suis embêté ... en scindant les colonnes de recherches, on défait un petit peu la logique droite a gauche ie si j'ai un mot unique a droite d'un expression (groupe de mot), le groupe de mot va etre abrégé avant le mot unique ce qui me ramène pratiquement au point de départ.

J'ai fais un test en mettant les groupes de mots dans E et résultat F et j'ai eu ce constat.


Est-ce qu'il y a une façon de faire afin de ne pas séparer les groupes de mots au mot unique (tous sois dans la meme colonne sans priorisé un devant l'autre) ??? ... selon moi, ca pourrais peut etre corriger mon problème

[Marc-L]

J'aurais besoin d'un exemple bien précis et savoir les positions dans les listes.

Logiquement, la liste de droite - optionnelle dans le code - est réservée pour remplacer une séquence de mots
(exemple : " BASE EAU " remplacé par " EAU " - noter les espaces …)
ou pour supprimer soit une séquence de mots (exemple : ", VOIR DEVIS" remplacé par rien donc effacé !)

 soit un mot isolé comme un article (exemple : " LA " remplacé par " " donc par un espace).

Évidemment les mots isolés à supprimer doivent se trouver en-dessous des séquences de mots …

La liste de gauche étant utilisée après la liste de droite afin de traiter chaque mot restant,
si les listes sont renseignées en respectant la Logique, cela ne devrait pas poser de problème …

Ainsi en renseignant juste 18 entrées dans la liste de droite et en corrigeant la liste de gauche de 7 entrées,
après exécution de la procédure il y a seulement une cellule à modifier manuellement !

J'ai remarqué des entrées dans la liste de gauche pouvant être remplacées par une seule
sans compter certaines dont la logique m'échappe;
bref comme déjà évoqué cette procédure donnera de meilleurs résultats après correction de la feuille data !

S'il faut gérer une seule liste, le premier code s'en charge bien
mais là aussi la Logique doit être respectée quant à l'ordre des entrées …

[jpvba]

Bien sur, cher ami, je te met ci-joint un fichier avec les mêmes exemples.

test demo2.xlsx



Afin de pouvoir éliminer les lignes vides et faciliter la lisibilité, les mots unique sont en ordres alphabétique dans la colonne A dans le data



Également, il m'est plus dur de faire l'ordonnancement sans ordre alphabétique croissant ou décroissant lorsque les éléments sont sur une même rangé. Si je détruis une ligne en question, je supprime un élément de la colonne E et F. Si je détruit seulement les non voulu, j'ai toujours des espaces que je dois combler avec des couper/coller.


Mon data est monté de façon a couvrir toute les abréviations de ma base de donnée entière. Par exemple le "POMPE A" me cause le problème dans l'exemple donnée mais je sais qu'il n'est utile pour les pompe a insuline, pompe a perfusion, etc ... donc je ne veux pas l'effacer et le remettre dans mon data une fois le travail accomplie. Lorsque je vais avoir systématiquement un groupe de mot, la logique de droite a gauche ne sera plus jamais respecté ... étant donné de cette priorité


Certes dans les exemples données, la procédure ne donne pas beaucoup d'erreur mais par expérience dans le passé, j'ai souvent des demandes très longues dont des groupes de mot abrégé sont a gauche de simple mot donc le pourcentage d'erreur "tolérable" deviens passé.

J'ai mis également a la ligne 35 un exemple d'erreurs que je risque d'avoir tous le temps.


J'Ai trouver également un "bug" que j'ais mis a la cellule B29 ... en exécutant la procédures, on efface tous ce qui est a droite de la première parenthèse ce qui enlève A/CONTENANT DE MOUSSE 20.0 X 15.0 X 10.0CM (8 X 6 X 4")

Je suis conscient que les groupes de mots n'aurons guère le choix d'être mis par ordre de priorité devant un mot qui est contenu dans le groupe de mot en question ou que l'abréviation du groupe contient déjà le mot abrégé.


en te remerciant encore une fois pour ton temps investit a m'aider !!!!

[Marc-L]

J'ai optimisé la ligne de code n°10 pour le masque concernant les mesures anglo-saxonnes entre parenthèses,
modifié la ligne n°35 pour supprimer l'espace en doublon après la suppression d'un mot via la liste de gauche
et refondu le traitement du cas spécial de "POUR" lorsqu'il est abrégé puis,
pour vérifier le bon fonctionnement de sa logique, je suis reparti d'une base data vierge pour l'enrichir mot par mot :
à partir de ton dernier classeur joint, 49 entrées dans la liste de gauche et seulement 13 dans celle de droite
dont 4 qui auraient pu aussi être dans celle de gauche …

Dans la liste de droite - reste optionnelle et toujours prioritaire sur celle de gauche - il n'y a plus de mot isolé
à supprimer comme par exemple les articles (DE, DU, EN, …) mais les cas spéciaux des séquences de mots à traiter.
Il y a seulement deux cellules à modifier manuellement en lignes n°5 & 12.
Concernant la ligne n°5 tu as supprimé un mot dans ton résultat alors que tu l'as conservé dans la ligne précédente;
il pourrait être conservé aussi en ligne n°5 en supprimant les articles "A" …

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Sub Demo2a()
      Const C = 100
        Dim Rg As Range, oRExp As Object, VD, R&, Rc As Range, T$, SP$(), S$, P&
    With Feuil1.UsedRange.Rows
        Set Rg = Intersect(.Item("2:" & .Count).Columns(2), ActiveWindow.RangeSelection)
    End With
         If Rg Is Nothing Then Beep: Exit Sub
            Rg.Offset(, 2).Select
        Set oRExp = CreateObject("VBScript.RegExp")
            oRExp.Global = True:  oRExp.Pattern = " \(\d[^\(]*""\)"
               VD = Feuil2.UsedRange.Columns("A:B").Value
    With CreateObject("Scripting.Dictionary")
            For R = 1 To UBound(VD):  .Item(VD(R, 1)) = VD(R, 2):  Next
               VD = Feuil2.[E1].CurrentRegion.Value
        For Each Rg In Rg.Areas
            For Each Rc In Rg.Cells
                   T = Rc.Value
            If Len(T) > C Then
                       T = oRExp.Replace(T, "")
                If Len(T) > C Then
                    If IsArray(VD) Then
                        For R = 1 To UBound(VD)
                            If InStr(T, VD(R, 1)) Then
                                T = Replace$(T, VD(R, 1), VD(R, 2))
                                If Len(T) <= C Then Exit For
                            End If
                        Next
                    End If
                    If Len(T) > C Then
                           SP = Split(T)
                        For R = UBound(SP) To 0 Step -1
                                       S = Replace$(SP(R), ",", "")
                            If .Exists(S) Then
                                   SP(R) = Replace$(SP(R), S, .Item(S))
                                       T = Application.Trim(Join(SP))
                                    If Len(T) <= C Then Exit For
                                If SP(R) = "PR" Then
                                   SP(R) = ""
                                       T = Application.Trim(Join(SP))
                                    If Len(T) <= C Then Exit For
                                End If
                            End If
                        Next
                    End If
                End If
            End If
                Rc.Offset(, 2).Value = T
            Next
        Next
            .RemoveAll
    End With
            Set oRExp = Nothing
End Sub

[jpvba]

J'ai testé la procédure en enlevant les expressions composé ayant un article dans le "data" et le résultat n'est vraiment pas optimale

Par exemple POMPE A ALIMENTATION ENTERALE AMBULATOIRE SYSTEME OUVERT S/HYDRATATION - FORMATION DU PATIENT SOINS DE COURTE DUREE EN ETABLISSEMENT DE SANTE, SEULEMENT

deviens avec la procédure POMPE A ALIM. ENT. AMBUL. SYS. OUV. S/HYDRAT. - FORM. DU PATIENT COURTE DUREE EN ETAB. DE SANTE, SEUL.

au lieu de POMPE A ALIMENTATION ENT. AMBUL. SYS. OUV. S/HYDRAT. - FORM. PATIENT COURTE DUREE ETAB. SANTE, SEUL.


Je crois que je n'ai pas compris qqch ...

J'Ai peut-être trouvé une solution a tous mes problèmes mais je ne sais pas si ca va etre trop complexe ou trop lourd.


Si je me fis a mon lexique actuel qui selon moi est énormément complet, on pourrais le diviser selon le nombre de mot et le nombre de mot le plus long est égale a 6.

J'aurais un data 6 pour 6 mots, data 5 pour 5 mots, etc ... jusqu'a 1 mot.

LA macro lirais le dernier mot - 5 le data6, dernier mot -4 pour data 5, etc ... jusqu'a la fin et ensuite lirais dernier mot - 1 (avant dernier mot) data 6 pour (dernier mot -1) - 5 pour data 6, etc ...

Quand penses tu ???

[Marc-L]

Tout dépend déjà de la logique de la feuille data !

Par exemple POMPE A ALIMENTATION ENTERALE AMBULATOIRE SYSTEME OUVERT S/HYDRATATION - FORMATION DU PATIENT SOINS DE COURTE DUREE EN ETABLISSEMENT DE SANTE, SEULEMENT

deviens avec la procédure POMPE A ALIM. ENT. AMBUL. SYS. OUV. S/HYDRAT. - FORM. DU PATIENT COURTE DUREE EN ETAB. DE SANTE, SEUL.

au lieu de POMPE A ALIMENTATION ENT. AMBUL. SYS. OUV. S/HYDRAT. - FORM. PATIENT COURTE DUREE ETAB. SANTE, SEUL.

Déjà dans ta liste de gauche il manque l'article "DU" !

De mon côté avec ma mini base data j'obtiens
POMPE A ALIMENTATION ENTERALE AMBUL. SYS. OUV. S/HYDRAT. - FORM. COURTE DUREE ETAB. SANTE, SEUL.

Il n'y a pas le mot PATIENT vu qu'apparaît plusieurs fois dans les cellules la séquence " PATIENT SOINS DE "
elle figure donc dans ma liste de droite et remplacée par juste un espace car dans ton résultat d'une autre cellule
cette séquence est bien supprimée, il faut donc qu'il y ait une cohérence dans la logique globale
mais pas un coup je conserve un mot puis une autre fois je le supprime, c'est ingérable …

[jpvba]

OK, là je comprends


Nice !!! ta procédure permet de remplacer les articles superflus par un "vide" ... mon ancienne sub ne me le permettais pas dû moins causait des problèmes ..


encore plus géniale, là j'arrive au même résultats !!!

[Marc-L]

Enfin !

Scinder en deux listes permet de mieux visualiser le remplacement global des séquences de mots et prioritaire
sur le traitement mot par mot dans l'ordre inversé au lieu d'une liste unique fourre-tout !

il m'est plus dur de faire l'ordonnancement sans ordre alphabétique croissant ou décroissant lorsque les éléments sont sur une même rangé. Si je détruis une ligne en question, je supprime un élément de la colonne E et F. Si je détruit seulement les non voulu, j'ai toujours des espaces que je dois combler avec des couper/coller.

Et non ! Ne pas sélectionner une ligne entière mais juste les cellules constituant une rangée d'une liste
puis via le clic droit soit Insérer soit Supprimer …

[jpvba]

J'ai essayé intensivement le code et WOW, plus que bien !!!

pour les unités de mesure anglo-saxonne ou autre , a quel endroit du code je peux les ajouters (par exemple le symbole ' pour pieds et je pourrais rajouté oz pour les liquides, etc ...) ????

pour les éléments ayant plusieurs mot (colonne E dans mon data), le tout de semble fonctionner un fois de temps en temps ... je tente de trouver le pkoi des cas auquel cela ne fonctionne pas ... c'est peut-être un erreur de ma part, je vais chercher


J'Ai trouvé ... j'avais une espace blanc qq part

plus peur que de mal !!!!

[Marc-L]

pour les unités de mesure anglo-saxonne ou autre , a quel endroit du code je peux les ajouters (par exemple le symbole ' pour pieds et je pourrais rajouté oz pour les liquides, etc ...) ????

Si c'est un cas identique aux mesures entre parenthèses avec un guillemet alors il suffit juste d'utiliser un nouveau Pattern
(cf ligne de code n°10 et tutoriel Les Expressions Rationnelles appliquées en VBA entre autres).

Sinon avec des exemples précis …

Pour éviter de trop modifier le code - déjà limite d'une usine à gaz - les Patterns pourraient être dans une liste dédiée.
Idem s'il y a d'autres cas à traiter comme "POUR", mieux vaut ouvrir une liste …

[jpvba]

Effectivement, il s'aggit de "pattern" mesure anglo-saxonne. Donc je vais lire le lien que tu m'as suggéré !!!


Est-ce que tu sais le format du fichier car lorsque je clique sur le line on me demande d'ouvrir ou télécharger le fichier en question et le fichier n'a pas d'extension

mille fois merci !!!

[Marc-L]

Le lien est une page de ce site !

Sinon c'est juste l'apostrophe à la place du guillemet ? Est-ce si compliqué d'être précis ?‼

Car sans précision un code ne saurait l'être …

[jpvba]

désolé, le lien ne fonctionne pas de mon coté ... même en cherchant le titre sur Google, j'arrive a l'adresse donné et on me demande de sauvegarder regexp



Pour les mesures de longueurs : '

Pour le poids: oz, lb

Pour le volume : us fl oz, uk fl oz


Il se peut qu'il en a d'autre mais ce sont les principales .... désolé de ne pas avoir été plus précis

[Marc-L]

Et tout cela c'est bien entre parenthèses et à la place du guillemet ?!

[jpvba]

effectivement entre parenthèse


L'actuel procédure enlève la parenthèse et son contenus en priorité 1 lorsque l'information dans la parenthèses est une mesure en " et que bien sûr, le nombre de caractère est supérieur a 100. Elle enlève une information qui est complémentaire donc c'est ce qu'il faut pour répondre a mon besoin.


Par exemple SERRURE POUR COURROIE ABDOMINALE A/CABLE 70CM (27 1/2") CONNECTEUR 2 PRISES JAUNE COMPATIBLE, JETABLE deviens =>

SERRURE POUR COURROIE ABDOMINALE A/CABLE 70CM CONNECTEUR 2 PRISES JAUNE COMPATIBLE, JETABLE

Ce que je veux faire c'est lorsque que le contenu de la parenthèse contient d'autre information complémentaire (les autres mesures anglo-saxonnes) qu'elle réagisse de la même également de la même façon.


Par exemple :

SERRURE POUR COURROIE ABDOMINALE A/CABLE 120CM (4') CONNECTEUR 2 PRISES JAUNE COMPATIBLE GOLD, JETABLE deviens =>

SERRURE POUR COURROIE ABDOMINALE A/CABLE 120CM CONNECTEUR 2 PRISES JAUNE COMPATIBLE GOLD, JETABLE

[Marc-L]

Modification du masque de la ligne de code n°10 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

            oRExp.Global = True:  oRExp.Pattern = " \(\d[^\(]*((u[ks] fl )?oz|lb|['""])\)"

[jpvba]

Merci !!!

[jpvba]

J'ai 2 petite modification a apporté a code etant donné qu'il se peut que je dois insérer des colonne dans le fichiers.


DOnc en essayant la sub, j'ai remarquer que la 1er colonne a gauche dois etre absolument ma No d'item(que j'ai nommer la plage: no_item_travail). Si j'insert une colonne avant ca ne fonctionne plus.


Comment remédié a cette première modif. ???



Seconde modif. si j'insert des colonnes entre ma description longue et ma descripton courte, étant donné l'utilisation de offset, les donnés ne sont plus a la bonne endroit.



encore mille fois merci !!!


Je l'aisse le code auquel j'ai efffectué quelques modifications mineure

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub Droiteagauche100_création()
    Const c = 100
    Dim Rg As Range, oRExp As Object, VD, R&, Rc As Range, T$, SP$(), S$, P&
 
    With Sheets("Travail").UsedRange.Rows
        Set Rg = Intersect(.Item("2:" & .Count).Columns(Range("prov_long_travail").Column), ActiveWindow.RangeSelection)
    End With
         If Rg Is Nothing Then Beep: Exit Sub
            Rg.Offset(, 2).Select
        Set oRExp = CreateObject("VBScript.RegExp")
            oRExp.Global = True:  oRExp.Pattern = " \(\d[^\(]*((U[KS] FL )?OZ|LB|GALLON|OZ|MM|['""])\)|\(# ?\d*\)"
               VD = Sheets("data").UsedRange.Columns("A:B").value
    With CreateObject("Scripting.Dictionary")
            For R = 1 To UBound(VD):  .Item(VD(R, 1)) = VD(R, 2):  Next
               VD = Sheets("data").[E1].CurrentRegion.value
        For Each Rg In Rg.Areas
            For Each Rc In Rg.Cells
                   T = Rc.value
            If Len(T) > c Then
                       T = oRExp.Replace(T, "")
                If Len(T) > c Then
                    If IsArray(VD) Then
                        For R = 1 To UBound(VD)
                            If InStr(T, VD(R, 1)) Then
                                T = Replace$(T, VD(R, 1), VD(R, 2))
                                If Len(T) <= c Then Exit For
                            End If
                        Next
                    End If
                    If Len(T) > c Then
                           SP = Split(T)
                        For R = UBound(SP) To 0 Step -1
                                       S = Replace$(SP(R), ",", "")
                            If .Exists(S) Then
                                   SP(R) = Replace$(SP(R), S, .Item(S))
                                       T = Application.Trim(Join(SP))
                                    If Len(T) <= c Then Exit For
                                If SP(R) = "PR" Then
                                   SP(R) = ""
                                       T = Application.Trim(Join(SP))
                                    If Len(T) <= c Then Exit For
                                End If
                            End If
                        Next
                    End If
                End If
            End If
                Rc.Offset(, 2).value = T
            Next
        Next
            .RemoveAll
    End With
            Set oRExp = Nothing
End Sub