Detection de mots et gestion de position VBA
Résolu
Bonjour,
J'ai une colonne dont chaque cellule contient un seul ou plusieurs ingrédients, par exemple: Sodium Citrate;Sodium percarbonate;Sodium Carbonate;Sodium Chloride;Sodium Metasilicate;Polyaspartic acid;Alcohol Ethoxylate;Iminodisuccinic acid;enzymes;Polyvinyl Alcohol.
Je voudrai programmer une macro qui:
1) me fasse une liste de tous les ingrédients dans une autre feuille (sans répéter 2 fois un même ingrédient).
2) compte le nombre de fois que cette ingrédient apparaît en 1ère position , 2ème position, 3ème position, etc.
Le tableau final devra donc comporter plusieurs colonnes: une contenant la liste des ingrédients et une pour chaque position d'apparition. Les difficultés pour moi ici sont: comment faire la liste des ingrédients et comment gère-t-on la reconnaissance de la position par Excel?
Merci d'avance à ceux qui pourront m'aider, ça fait un moment que je patauge...
J'ai une colonne dont chaque cellule contient un seul ou plusieurs ingrédients, par exemple: Sodium Citrate;Sodium percarbonate;Sodium Carbonate;Sodium Chloride;Sodium Metasilicate;Polyaspartic acid;Alcohol Ethoxylate;Iminodisuccinic acid;enzymes;Polyvinyl Alcohol.
Je voudrai programmer une macro qui:
1) me fasse une liste de tous les ingrédients dans une autre feuille (sans répéter 2 fois un même ingrédient).
2) compte le nombre de fois que cette ingrédient apparaît en 1ère position , 2ème position, 3ème position, etc.
Le tableau final devra donc comporter plusieurs colonnes: une contenant la liste des ingrédients et une pour chaque position d'apparition. Les difficultés pour moi ici sont: comment faire la liste des ingrédients et comment gère-t-on la reconnaissance de la position par Excel?
Merci d'avance à ceux qui pourront m'aider, ça fait un moment que je patauge...
17 réponses
Résumé de la discussion
Le problème porte sur l’extraction d’une liste sans doublons d’ingrédients à partir d’une colonne où chaque cellule peut contenir plusieurs ingrédients séparés par des points-virgules, et le comptage de leur position d’apparition (première, deuxième, etc.). Les solutions proposées préconisent de splitter chaque cellule avec Split(';'), de nettoyer les espaces éventuels par Trim et d’alimenter un dictionnaire pour constituer la liste unique, tout en comptant les occurrences par position lors de l’enregistrement des éléments dans les colonnes suivantes. Plusieurs difficultés techniques ont été évoquées, comme la gestion de plages dynamiques, le traitement des cellules vides, les erreurs lors du copier-coller de macros entre fichiers, et les limites liées au nommage des feuilles ou au fait de placer le code dans une feuille plutôt que dans un module. Des conseils soulignent l’intérêt du dictionnaire pour éviter les doublons et l’importance du nettoyage des chaînes, avec des vérifications d’existence et des traitements d’erreurs pour rendre la macro robuste.
-
bonjour
peux tu envoyer une partie significative de ton fichier au format excel 2003 sur cjoint.com et joindre le lien obtenu à ton prochain message, ça permettra de voir de façon plus précise comment les données sont organisées
bonne suite -
Voici: http://cjoint.com/?3Hkr5hRVEBl
La feuille 1 montre les donnée telles quelles et la feuille 2 est la feuille où les données doivent être placé.
Merci en tout cas de venir à mon aide. -
une question
dans une ligne de la feuille 1, un élément peut il apparaitre plusieurs fois? -
ContributeurBonjour,
Une proposition :https://www.cjoint.com/?BHktckXtWl8
eric
PS : Je viens de voir que tu as mis ton fichier après que j'ai fait le mien.
Pas encore ouvert mais je pense que tu pourras adapter.
edit: ton fichier adapté avec le total en plus.
https://www.cjoint.com/?BHktBaal0gR
Bon app à ccm81 ;-)
Jamais tu ne répondras à un mp non sollicité...
Bon, ça c'est fait. -
bonjour eric
beau travail, il ne manque que la colonne des nb d'occurences, mais ça ne devrait pas poser de problème à Jack
je vais pouvoir aller diner tranquille ....
j'en étais à la partie (délicate) du dénombrement des positions, je regarderai avec intérêt ta solution demain
cordialement -
ContributeurRe,
Je ne peux plus modifier mon post 4
Je viens de voir qu'il y a sans doute un bogue : un total ne peux être égal à 0...
Pas bien grave, je reverrais ça ce we.
Edit : la version corrigée, c'était un oubli suite à l'ajout du total : https://www.cjoint.com/?BHkwR1Jtn2Z
eric
Jamais tu ne répondras à un mp non sollicité...
Bon, ça c'est fait. -
Bonjour eriiic,
Merci beaucoup pour cette aide precieuse, ca a l'air de bien fonctionner. Je suis en train d'essayer de comprendre le programme et il y a une ligne que je comprends pas: c'est quoi CreateObject("Scripting.Dictionary")? -
Ce document m'a bien éclairer, merci. Sinon, je suis en train d'essayer de l'appliquer a mon classeur mais je n'y arrive pas, comment je fais pour qu'un bouton apparaisse? J'ai essaye de copier le code dans un module mais ça ne marche pas, j'ai erreur d'exécution '9'. J'ai pourtant change le nom des onglets et les cellules concernées...
Que dois-je faire?-
ContributeurTout dépend de ta version d'excel.
Sur 2003 : menu 'affichage / barres d'outils / boites à outils contrôles', cliquer sur l'outil 'bouton', cliquer sur la feuille pour le placer.
Puis double-cliquer sur le bouton créé pour accéder à son code. Copier-coller le code entre sub et end sub.
Si pb tu déposer ton fichier sur cjoint.com
eric -
Excel 2010. J'ai trouve comment mettre le bouton, par contre il y a un problème au niveau du 'split' apparemment. Mon dossier est le même que précédemment quasiment a part la colonne concernée est en D au lieu de A et que mon onglet source s'appelle "Focus Detail".
Voici mon code adapté:
Option Explicit
Sub Bouton1_Cliquer()
Dim shSource As Worksheet, shListe As Worksheet
Dim plage, c, lig As Long
Dim dico, composition, maxPos As Long
Dim i As Long
Set shSource = Worksheets("Focus Detail")
'
Application.ScreenUpdating = False
Set shListe = Worksheets("Liste")
' nettoyer Liste
shListe.Cells.ClearContents
'
' Passe 1 : liste composants
Set dico = CreateObject("Scripting.Dictionary")
plage = shSource.Range("D2", [D65000].End(xlUp)).Value
For Each c In plage
composition = Split(c, ";")
For i = 0 To UBound(composition)
If Not dico.Exists(Trim(composition(i))) Then dico.Add Trim(composition(i)), 1
Next i
' mémorisation nb max de composants
If UBound(composition) > maxPos Then maxPos = UBound(composition)
Next c
' coller liste
shListe.[a2].Resize(dico.Count, 1) = Application.Transpose(dico.keys)
'
' Passe 2 : position composants
For Each c In plage
' comptage composants par position
composition = Split(c, ";")
For i = 0 To UBound(composition)
Set c = shListe.[a2].Resize(dico.Count, 1).Find(composition(i), LookIn:=xlValues)
shListe.Cells(c.Row, i + 3) = shListe.Cells(c.Row, i + 3) + 1
Next i
'
Next c
'
' total
For lig = 2 To shListe.[a65000].End(xlUp).Row
shListe.Cells(lig, 2) = Application.Sum(shListe.Cells(lig, 3).Resize(1, maxPos))
Next lig
' titres colonnes
shListe.[A1] = "Liste Ingrédient"
shListe.[B1] = "Total"
For i = 1 To maxPos + 1
shListe.Cells(1, i + 2) = "Pos. " & i
Next i
shListe.Rows(1).Font.Bold = True
'
'
Application.ScreenUpdating = True
shListe.Activate
End Sub -
-
-
ContributeurRegarde si ça te va : https://www.cjoint.com/?BHolwsCLxZW
eric
-
-
ContributeurLes cellules ne sont pas vides, mais #N/A...
https://www.cjoint.com/?BHormnmX5eY
eric
Jamais tu ne répondras à un mp non sollicité...
Bon, ça c'est fait. -
ContributeurRe,
C'est l'espace après Beefhide qui perturbait.
J'avais essayé d'anticiper cet éventuel problème avec Trim() mais il en manquait encore un.
https://www.cjoint.com/?BHpaoPDzmY6
eric-
Ah d'accord, par contre il y a un autre problème, certain totaux sont égaux a 0 et donc l'ingrédient en question est juste dans la liste mais ces position ne sont pas comptée (par exemple salt et titanium dioxide dans le fichier que tu m'as envoyé).
Il me semble (voir ton post 2) que tu avais résolu ce problème dans les versions précédente, que faut-il faire? -
-
-
ContributeurBonjour,
C'était dû à un autre problème, salt étant présent à l'intérieur d'une autre chaine je l'inscrivais au mauvais endroit.
C'est corrigé.
Comme tu évoquais des pb majuscule/minuscule par sécurité je converti tous les noms en minuscule.
Tu as Alaska Pollock;Alaska pollock;... en position 1 et 2 présents sur 2 lignes.
Avant ils étaient présents séparément sur 2 lignes (avec un des totaux à 0) ce qui pouvait attirer l'oeil sur une anomalie... (dans la mesure où la casse est différente)
Dis si c'est normal ou si c'est une anomalie due au fichier de test qui ne se représentera pas en réel.
Et si je maintiens la conversion en minuscule et donc la fusion des 2 noms.
https://www.cjoint.com/?BHpocZzdcHe
eric
Jamais tu ne répondras à un mp non sollicité...
Bon, ça c'est fait. -
C'est parfait merci beaucoup! J'aurai juste besoin d'un dernier coup de main si cela ne te dérange pas: il faudrait que je fasse la même chose pour chaque Sub-Category. C'est comme si sur le fichier actuel, j'appliquais le filtre Sub-Category et que j'appuyais sur le bouton Maj.
Voila je voudrais automatiser ça et que pour chaque Sub-Category ça me crée un onglet ayant le nom de la Sub-Category et contenant la liste et position de ses ingrédients.
Merci-
-
-
-
ContributeurCombien de temps actuellement ?
Combien de lignes et de sub-category ?
Processeur, fréquence et taille mémoire ?
En fait tu l'aurais dit tout de suite le problème aurait été abordé différemment.
Là je vais réutiliser ce qui a déjà été fait alors qu'on aurait pu traiter en parallèle toutes les sub-catégories (ce qui obligerait à tout refaire...)
eric -
-
-
Je suis en train d'essayer ma proposition. J'aurai besoin de savoir comment on accède a un élément du dictionnaire, concrètement je voudrais écrire ça:
"Si cells(i,3).Value= element j du dictionnaire"-
ContributeurBonjour,
Ce n'est pas comme ça que l'on travaille avec un dictionary.
C'est un tableau de clés (keys) auxquelles sont associées un item.
Tu peux obtenir l'item à partir de la clé : dico.item(clé)
Dans l'exemple que tu demandes il faut utiliser un tableau classique. Beaucoup moins rapide certes, mais toutes les possibilités habituelles d'un tableau.
eric -
ContributeurPS: excellent site avec des exemples d'utilisation du dictionary :
http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm
eric -
-
-
-
J'ai tenté un truc mais ça bloque en me disant "next sans for", pourtant il y a bien un For pour le Next en question.
Pourrais-tu y jeter un coup d'oeil s'il te plait?
Voici le lien: http://cjoint.com/?3HrqXgEJsmX -
Bonjour eriiic,
J'ai avancé dans le programme mais j'ai encore quelques problèmes qui bloquent l'exécution.
Déjà, lors de la création de la liste des subcategory (j'ai utilisé un tableau) j'ai remarqué en ajoutant un msgbox, qu'il y avait des répétitions alors que je veux qu'il n'y ait pas de répétition. Je pense que c'est également ce qui bloque le programme par la suite.
Pourrais-tu y jeter un oeil et voir si mon algorithme a une chance de fonctionner s'il te plait?
Voici le fichier: http://cjoint.com/?3Hupaz5DvzY
Merci d'avance-
ContributeurBonjour,
Désolé mais je passerais plus de temps à essayer de corriger ton programme qu'à le faire directement.
De plus sur ton fichier (chez moi) le bouton existe sans exister (?) et le code est impossible à lancer.
Si tu veux une liste sans doublons il est plus efficace d'utiliser un directory quitte à transferer le résult dans un tableau si nécessaire.
Sinon à chaque ajout il faut boucler sur le tableau pour voir si l'élément existe déjà (d'où l'interet du dictionary avec son .exists)
eric -
Ok, alors si c'est possible, juste ce passage de code:
'Liste des Sub-category
ReDim sublist(0)
For i = 2 To [C65000].End(xlUp).Row
For j = 0 To UBound(sublist)
If Not Cells(i, 3).Value = sublist(j) Then
ReDim Preserve sublist(line_insertion)
sublist(line_insertion) = Cells(i, 3).Value
line_insertion = line_insertion + 1
End If
Next j
Next i
N'est-ce pas censé créer une liste des subcategory sans doublons? Ou est l'erreur ici?
PS: je vais jeter un oeil au directory aussi, mais je vois toujours pas pourquoi ca ne marcherait avec un tableau directement. -
ContributeurCa serait plus qcq chose comme ça :
'Liste des Sub-category Dim ok As Boolean ReDim sublist(0) For i = 2 To [C65000].End(xlUp).Row ok = True For j = 0 To UBound(sublist) If Cells(i, 3).Value = sublist(j) Then ok = False Exit For End If Next j If ok Then ReDim Preserve sublist(line_insertion) sublist(line_insertion) = Cells(i, 3).Value line_insertion = line_insertion + 1 End If Next i
Mais ça sera beaucoup plus lent qu'avec un dictionary.
Tu crées ta liste sans doublon avec, et tu termines avec
Dim liste()
liste = dico.keys
si tu as besoin des fonctionnalités d'un tableau.
eric -
ça marche merci. Pourquoi a-t-on introduit un booléen? Quelle était l'erreur dans ma fonction?
Autre question: Comment peut-on tester si un dictionnaire est vide?
J'en ai besoin car comme je le fais pour chaque subcategory, je vide a chaque fois le dico et du coup certaines subcategory ne contenant pas d'ingrédients me font bugger le programme (notamment la partie que tu avais appeler "coller liste"). -
ContributeurPourquoi a-t-on introduit un booléen? Quelle était l'erreur dans ma fonction?
Dans le for il faut balayer l'ensemble du tableau pour savoir si l'item est déjà présent, pas seulement une seule valeur (ce que tu faisais).
Si on trouve on force une sortie de la boucle (inutile de continuer) et ok = false.
Si ok = true il faut ajouter le nouvel élément.
Comment peut-on tester si un dictionnaire est vide?
Idem que pour un tableau : .count
eric
-
-
Merci beaucoup le programme marche sur mon fichier test, par contre sur cet autre fichier test il bug... Il me dit "la fonction Range de_Worksheet a échoué", c'est au niveau de la définition de la plage de données "plage".
Je n'arrive vraiment pas a trouver qu'est-ce qui cloche, voici le fichier: http://cjoint.com/?3HvloYkcKfL
Merci-
ContributeurBonjour,
"la fonction Range de_Worksheet a échoué"
Ta feuille shSource doit être activée.
Par ailleurs :
plage = shSource.Range("H2", [H65000].End(xlUp)).Value
me parait plus logique que :
plage = shSource.Range("H1", [H65000].End(xlUp).Offset(1, 0)).Value
Et tu ne gères pas les erreurs sur la création/nommage sur une feuille déjà existante.
Je te conseille de te créer une feuille modèle (qui aura déjà les titres, les largeurs de colonne, etc), de supprimer d'office la feuille à créer en gérant l'erreur si elle n'existe pas, et de créer ta nouvelle feuille à partir de la feuille 'modèle'.
ex :On Error Resume Next Application.DisplayAlerts = False Sheets(sublist(p)).Delete On Error GoTo 0 Application.DisplayAlerts = True Sheets("Modèle").Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = sublist(p)
(je n'ai pas regardé dans le détail ton code, il y a peut-être une adaptation à faire. Sur l'emplacement dans le code par exemple)
eric -
Le problème précédent s'est réglé en plaçant le code dans Feuil2 plutôt que dans un module, ça revient a activer shSource j'ai l'impression.
"Et tu ne gères pas les erreurs sur la création/nommage sur une feuille déjà existante. "
Je ne comprends pas vraiment ce que tu veux dire... c'est quoi ces erreurs? Ou dois-je insérer ton bout de code?
De plus, maintenant j'ai une erreur 400 lors de l'exécution, c'est peut-être du a ce que tu mentionnes?
Voici le fichier: http://cjoint.com/?3Hvon3Fd3Iv
Encore une fois, merci beaucoup pour ton aide. -
Contributeur"Et tu ne gères pas les erreurs sur la création/nommage sur une feuille déjà existante. "
Je ne comprends pas vraiment ce que tu veux dire... c'est quoi ces erreurs?
Si une feuille est existante, tu ne peux pas réutiliser le même nom, ça génère une erreur.
Actuellement il faut supprimer manuellement toutes les feuilles crées avant de lancer la macro...
erreur 400
Des tests (pas trouvé de docu là dessus) m'ont permis de voir qu'un nom d'onglet est limité à 31 caractères.
"Boxed Meats - Family Size Frozen" en fait 32.
eric -
Ok, j'ai résolu ca par un Left avec 31 comme limite.
Par contre maintenant il me dit "incompatibilité de type" pour l'onglet "Boxed Meats - Family Size Frozen" justement, je ne vois pas en quoi il est différent des autres...
Un autre problème que j'avais oublie de mentionner, il y a des onglets ou "Pos." arrête de s'inscrire au bout d'un moment (voir onglet 2 et 4), alors que pour l'onglet 2 ca marche. Il y a pourtant la condition " If UBound(composition) > maxPos Then maxPos = UBound(composition)", qu'est-ce qui manque?
Voila le fichier: http://cjoint.com/?3HvpAZ2owIn -
-
-
Ok merci. Juste encore une chose, tu peux m'expliquer ou et comment est calculé le nombre total d'apparition dans ton morceau de code suivant?
For Each c In plage2
If Not IsError(c) Then
If c <> "" Then
composition = Split(c, ";")
For i = 0 To UBound(composition)
If Not dico.Exists(LCase(Trim(composition(i)))) Then
dico.Add LCase(Trim(composition(i))), 1
Else
dico.Item(LCase(Trim(composition(i)))) = dico.Item(LCase(Trim(composition(i)))) + 1
End If
Next i
' mémorisation nb max de composants
If UBound(composition) > maxPos Then maxPos = UBound(composition)
End If
End If
Next c
