Detection de mots et gestion de position VBA

Bonjour,

C'est pour créer un 'dictionnaire', objet très très rapide pour créer des listes sans doublons (entre autre...).
Voir une présentation ici.
Dans la suite du code le dictionnaire créé s'appelle 'dico'.
eric

Tout 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

Bonjour,

par contre il y a un problème au niveau du 'split'
C'est vague...
Dépose un extrait de ton fichier sur cjoint.com

eric

Voila: http://cjoint.com/?3HolfDunyo6

Regarde si ça te va : https://www.cjoint.com/?BHolwsCLxZW
eric

Ah oui, désolé j'avais pas fais attention. Par contre, maintenant ça bug a un autre endroit, voici un fichier avec quelques lignes de plus qui le font bugger je ne sais pas pourquoi:
http://cjoint.com/?3HorPKLYEQK

Oubli ce que j'ai dit sur la casse des mots (si tu as lu mon précédent message avant que je le modifie) , c'est très bien comme ça.
Par contre le programme bug toujours et j'arrive pas a en déterminer la cause.

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?

Je ne sais pas si c'est utile, mais je viens de remarquer que le problème était déjà présent dans le dernier fichier que je t'avais envoyé (avant modifs pour beefhide).

Arghhh, tu ne pouvais pas le dire dès le début ?
En plus ou à la place ?

eric

Désolé, la consigne ne m'a été donnée que maintenant...:s
En plus mais ce n'est pas important si c'est plus simple a la place c'est bon aussi, vu que j'ai déjà un fichier fonctionnel.

Après réflexion, mieux vaut direct a la place vu le temps que met la macro a s'exécuter (le fichier original est très gros). Mais encore une fois le plus simple ira.

Merci

Combien 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

A peu près 3min. Il y a plus de 4000 lignes et plus de 150 sub-category.
processeur intel i3, 2,40GHz, 4 Go.
Encore une fois, tu peux reprendre ce qui a été fait ça ira très bien.

Merci

Bonjour,

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

PS: excellent site avec des exemples d'utilisation du dictionary :
http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm

eric

Ok je vais y jeter un oeil, je suis en train d'essayer avec les tableaux.

Tiens moi au courant de tes avancées.
Dans l'immédiat je n'ai pas trop le temps mais si tu as trouvé pas la peine que je me penche dessus.

eric

il te manque le endif de
If Cells(k, 3).Value = book.Key(p) Then

eric

Ah oui merci. Maintenant que j'ai corrige l'erreur il me dit "Erreur d'exécution '438': Propriété ou méthode non gérée par cet objet" a propos de ce if justement.
Cette condition devrait s'écrire autrement?

tu as posé la question tout à l'heure, à aucun moment je t'ai dit que tu pouvais obtenir une clé d'un dictionary par son index.
Je t'avais répondu qu'il fallait un tableau 'normal' pour ça.

eric

Bonjour,

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.

Ca 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").

Pourquoi 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

Bonjour,

"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.

"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

Dans ce cas de figure,
plage = shSource.Range("H2", [H65000].End(xlUp)).Value
plage a pour adresse H2 (1 seule cellule)
donc For Each c In plage plante

Pour pos. je n'ai pas le temps là, je dois m'absenter.

eric

Re,

dans dico.item()

If Not dico.Exists(LCase(Trim(composition(i)))) Then ' ' 1ère fois
dico.Add LCase(Trim(composition(i))), 1 ' on le fixe à 1
Else ' fois suivantes
dico.Item(LCase(Trim(composition(i)))) = dico.Item(LCase(Trim(composition(i)))) + 1 ' on ajoute 1

eric