Regrouper / transformer données similaires

Bonjour à tous,

J'ai une quête pour vous !

J'ai une base de donnée dans laquelle j'aimerai regrouper des éléments similaires car ces derniers sont rentrés en champs libres (ex : "1a1" "1A1" "1 a 1" "1a 1") j'aimerai regrouper toutes les cellules contenant ces textes similaires mais différents, pour faciliter la création d'un TCD. Est-ce possible ? (voir Feuil 1 pour exemple) Il y a d'autres type de données mais j'imagine qu'une fois que j'aurai la technique pour un type j'arriverai à le faire pour tous.

Ma quête secondaire est un peu plus complexe. Est il possible de détecter des données similaires mais différentes (ex : AA11-11AAA-AA11 similaire à AA11-11AAAA-AA11 mais avec un caractère en moins (erreur de frappe etc)) et faire en sorte de transformer la référence souligné en celle qui ne l'est pas ?

J'ai pensé à faire une macro qui recherche quand il y a un caractère supplémentaire et qui me permet de le transformer au cas par cas, mais je ne sais pas si c'est la meilleure méthode et je ne l'ai pas encore créée.

Je vous remercie de votre considération,

Bonne chance !
Fooled

7classeur1.xlsx (8.48 Ko)

Bonjour

Un essai à tester. Te convient-il ?

7classeur1-v1.xlsm (22.73 Ko)

Bye !

Bonjour !
C'est déjà très bien ! Merci beaucoup :)

Existe-t-il une petite ligne pour regrouper et passer toutes les majuscules en minuscule ?
J'ai réfléchi à une façon d'uniformiser mes données en mettant tous les exemples désirés dans une macro Replace What :="1A1", Replacement:="1a1"

Cela devrait fonctionner, j'ai juste à lister tous les exemples :)
Merci Encore !

Bonjour à tous,

Un test qui fonctionne quelque soit les lettres et espaces. Pour mettre en minuscule c'est la méthode LCase qu'il faut utiliser :

Sub MINUSCULE()
Dim L%
L = 2
Do While Cells(L, 1) <> ""
    Cells(L, 2) = Replace(LCase(Cells(L, 1)), " ", "")
    L = L + 1
Loop
End Sub

Cdlt,

Bonjour Ergotamine,

Je comprends la macro, mais ne sait pas comment l'appliquer (donc enfaîte je ne la comprends pas trop ahahah)...

Il faut remplacer les "Cells" par mes cellules concernées ? J'ai essayé mais cela ne fonctionne pas, si je ne change rien à la formule et que je la lance, elle mouline, mais dans le vide.

J'ai un Tableau donc peut-être qu'il ne faut pas écrire la même chose ?

(Quelque chose comme Range("Tableau1[Données A]" par exemple)
Désolé je suis encore débutant en Excel et VBA, mais j'ai soif de vos connaissances !

Ci joint un excel pour me montrer éventuellement

8classeur-test.xlsx (11.20 Ko)

Merci de votre aide :)

Bonjour,

Un second test même si je sens que le résultat ne sera pas l'attendu sur une cellule .. :

Sub MINUSCULE()
Dim L%, C%, R%, RESULTAT$
Dim R_I()
Dim R_F()
R_I = Array(" ", "/")
R_F = Array("", "-")
For C = 1 To 2
L = 2
    Do While Cells(L, C) <> ""
    RESULTAT = Cells(L, C)
        For R = 0 To UBound(R_I)
             RESULTAT = Replace(LCase(RESULTAT), R_I(R), R_F(R))
        Next R
        Cells(L, C).Offset(0, 6) = RESULTAT
        L = L + 1
    Loop
Next C
End Sub

Le code est directement à insérer dans un module et à exécuter.

Cdlt,

Malheureusement cela n'as pas fonctionné, enfin ça à copié les connées de ma colonne A dans plusieurs de mes colonnes, (B,G et H)... Je pense que je vais simplement faire la première étape via la macro et la seconde en rajoutant une colonne et la formule =MINUSCULE

Merci quand même pour la tentative !

Bonjour,

Qu'entendez vous par "ça n'a pas fonctionné" ... ? Qu'est ce qui ne correspond pas au résultat attendu ? Hormis la cellule A2/G2 ? Chez moi le résultat attendu via ce code est obtenu.

Vous trouverez ci-joint le code inséré dans votre fichier, il ne reste qu'à l’exécuter.

Cdlt,

Bonjour à toutes et tous !

Hello Gmb, Ergotamine

Une proposition via Power Query .....

Bonjour,

Qu'entendez vous par "ça n'a pas fonctionné" ... ? Qu'est ce qui ne correspond pas au résultat attendu ? Hormis la cellule A2/G2 ? Chez moi le résultat attendu via ce code est obtenu.

Vous trouverez ci-joint le code inséré dans votre fichier, il ne reste qu'à l’exécuter.

Quand je dis cela, ce n'est pas votre macro, c'est mon tableau. De base, il est bien plus grand que celui présenté dans le classeur test.

Il y a beaucoup plus de colonnes, ce qui implique un remaniement de la macro je pense, mais je ne peux pas vous transmettre l'Excel de base, que puis-je faire pour adapter la macro ? Dois je vous dire le nombre de colonnes et dans quelles colonnes je veux que la macro soit effectuée ?

C'est pour cela que je voulais essayer de comprendre la macro pour pouvoir la réutiliser à ma façon.. Serait-il possible d'ajouter des notes à cette dernière pour que je puisse la comprendre et l'adapter ?

Une proposition via Power Query .....

Je dois simplement ouvrir mon fichier sous Power Query pour avoir ce genre de resultats ? Pour le souci de cellule A1, c'était juste un exemple de champ libre rentré par un utilisateur.

Je vous remercie pour votre implication, c'est très agréable d'avoir des experts à l'écoute !

Bonjour,

En fait lorsque vous dites que ça n'a pas fonctionné cela peut être frustrant pour nous car chez nous cela fonctionne, nous sommes quasi certain de notre code, mais au final ce n'est à priori pas le cas, sans savoir le pourquoi du comment, donc aucune marge de progression pour nous. D'où ma remarque. Le plus simple est de donner les exemples qui ne fonctionnent pas, le résultat attendu, etc ...

Ci-contre le code commenté :

Sub MINUSCULE()
Dim L%, C%, R%, RESULTAT$
Dim R_I()
Dim R_F()
R_I = Array(" ", "/") 'Créé un tableau avec les caractères cherchés à remplacer
R_F = Array("", "-") 'Créé un tableau avec les caractères de destination
For C = 1 To 2 'Pour les colonnes 1 à 2 (soit A à B)
L = 2 'Initie la variable Ligne à 2 (première ligne de la plage)
    Do While Cells(L, C) <> "" 'Boucle tant que la cellules à l'intersection de la ligne L, colonne C n'est pas vide
    RESULTAT = Cells(L, C) 'Charge le résultat de cette cellule dans la variable RESULTAT
        For R = 0 To UBound(R_I) 'Débute une boucle sur tous les caractères à remplacés
             RESULTAT = Replace(LCase(RESULTAT), R_I(R), R_F(R)) 'La variable RESULTAT devient la cellule chargée dans résultat, en minuscule et avec le premier caractère du tableau R_I remplacé par le premier caractère du tableau R_F
        Next R 'Passe au caractère suivant
        Cells(L, C).Offset(0, 6) = RESULTAT 'Inscrit la valeur contenue dans la variable RESULTAT dans la cellule à l'intersection de la ligne L et de la colonne C décalée de 6 colonnes (donc si C = 1 alors C = colonne A donc C.Offset(0,6) = F)
        L = L + 1 'On incrémente L (donc L devient 3, etc ..)
    Loop 'On recommence la boucle avec la nouvelle valeur de L
Next C 'On recommence avec la colonne 2, on réinitialise L à 2, etc, etc ...
End Sub

Cdlt,

Une proposition via Power Query .....

Je dois simplement ouvrir mon fichier sous Power Query pour avoir ce genre de resultats ? Pour le souci de cellule A1, c'était juste un exemple de champ libre rentré par un utilisateur.

Tout va dépendre de la représentativité des données fournies en exemple. Mais sur le principe.... oui... Power Query est un excellent collaborateur....

Je ne peux que vous inciter à investiguer ce fabuleux outil.

Au besoin, postez un fichier exemple plus exhaustif afin que nous puissions opérer plus en profondeur.

Bonjour Ergotamine et FJL.

Tout d'abord Ergotamine, je comprends votre point de vue et m'excuse du sentiment que vous avez pu ressentir, cela provient de mon tableau incomplet transmit.
Vous trouverez ci-joint un tableau épuré et sans données confidentielles. Les plage à étudiées sont les colonnes des options E et F de chaque produit (je n'ai juste pas rendu anonyme les valeurs des colonnes R et S mais il faut appliquer la formule sur toutes les colonnes de l'option E et F (c'est à dire colonne R; S; X; Y; AD; AE; AJ; AK; AP; AQ; AV; AW). Je pense que cela pourra vous aider d'avantage que mes précédents excels...
PS : Ne faites pas attention aux #REF ahah
Votre explication est claire et détaillée, merci de me faire progresser dans ma connaissance de VBA :)

5classeur-forum.zip (599.12 Ko)

FJL, effectivement, je n'avais pas pensé à Power Query de cette façon, j'ai découvert cet outil il y a quelques jour mais c'est vrai qu'il est très puissant !

Merci pour vos recherches à ce sujet,
Fooled

Bonjour,

Je me suis penché uniquement sur la colonne E et en effet je comprend votre désarroi .. Vous trouverez ci-joint les données de cette colonne E où :
- J'ai supprimé les doublons en colonne A
- J'ai fait passé ma macro et re supprimé les doublons en colonne B (d'où le différentiel de valeur)
- J'attend votre correspondance finale en colonne C mais je doute que cela puisse être automatisé sans table de correspondance

En gros avoir dans une table type celle jointe, vos critères initiaux, vers quoi vous souhaitez tendre et faire une RECHERCHEV dedans pour transformer toutes vos données.

Cdlt,

2harmonisation.xlsx (12.63 Ko)

Edit : Sauf si bien sûr vous trouvez une solution POWER QUERY.

Bonjour :)

Excellente idée ! du coup, à la fin, cela affichera les valeurs voulues (colonne final) qui viendront remplacer la colonne E (initial pre macro) en prenant en compte tous les formats identifiés dans la colonne Initial Post Macro ? Si c'est cela qui se passe c'est super puissant !

Si à l'avenir j'ai un nouvel élément qui se rajoute, comment l'intégrer dans la macro ? Il me faudra ajouter une feuille dans mon classeur c'est ça ?

Merci beaucoup de votre engagement,
FOOLED

3harmonisation.xlsx (12.96 Ko)

Bonjour,

Ci-contre votre code modifié :

Sub MINUSCULE()
Dim L%, C As Variant, R%, RESULTAT As Variant, CORRESP As Range
Dim COL()
Dim R_I()
Dim R_F()
Application.ScreenUpdating = False
Application.Calculation = xlManual
R_I = Array(" ", "/")
R_F = Array("", "-")
COL = Array(18, 19, 24, 25, 30, 31, 36, 37, 42, 43, 48, 49)
Set CORRESP = Worksheets("PARAM").Range("A1:B" & Worksheets("PARAM").Cells(Worksheets("PARAM").Rows.Count, 1).End(xlUp).Row)
For Each C In COL
L = 4
    Do While Cells(L, C) <> ""
    RESULTAT = Cells(L, C)
        For R = 0 To UBound(R_I)
             RESULTAT = Replace(LCase(RESULTAT), R_I(R), R_F(R))
        Next R
        Cells(L, C) = Application.IfError(Application.VLookup(RESULTAT, CORRESP, 2, 0), RESULTAT)
        L = L + 1
    Loop
Next C
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

J'ai déjà appliqué le code sur la colonne R afin que vous voyez le résultat.

La technique est simple : lorsque vous avez un critère que vous souhaitez transformer, vous le rajoutez à la suite de la feuille PARAM en colonne A et y mettez sa correspondance en colonne B puis lancez la macro.

Dans le fichier joint le plus gros travail reste à faire, malgré un premier nettoyage des espaces et remplacement des / par - puis suppressions des doublons de toutes les colonnes, il reste 989 valeurs uniques, donc je pense, la plupart ne sont pas à modifier. Pour vous éviter de refaire le travail une seconde fois les lignes en rouges restent à faire, celles en vertes sont faites. J'ai trier par ordre alphabétique les colonnes A et B afin d'avoir une suite cohérente et limiter le travail cérébral à faire (interruption de tâches etc etc ...)

J'ai aussi réduit votre tableau a 1011 lignes, inutile que j'aille jusqu'à 3000 et quelques ça ralenti la macro car elle passe tout de même à travers ces lignes vides.

Je reste à dispo si besoin.

Cdlt,

3harmo.zip (430.79 Ko)

Edit : Cette table de correspondance vous sera également demandée si vous travaillez sous POWER QUERY pour réaliser des jointures externes multitables, ce travail fastidieux n'est donc pas perdu.

Edit 2 : Savez vous pourquoi vous avez une telle disparité de saisies ? Il faudra que vous vous attaquiez dans un second temps à la root cause : la standardisation de la saisie des données. Si vous ne le faites pas vous allez devoir refaire cette manipulation régulièrement ..

Rechercher des sujets similaires à "regrouper transformer donnees similaires"