Liste de mots dans une cellule à partir d'un tableau
Bonjour a tous,
Je touche quasiment au but, il me reste a peaufiner et c'est la que je vais avoir besoin d'aide parce que je pense que ce que j'ai fait est plutôt brut de décoffrage.
Je vais essayer d'être clair, car le fichier est complexe en soi et du coup, je vous mets en pj le fichier.
J'ai une feuille appelée Caloric Value dans laquelle j'ai un tableau (B7:E22) ou je vais sélectionner dans la première colonne des ingrédients et leur pourcentage dans la formule dans la seconde colonne. Dans la 3e colonne apparait le statut réglementaire s'il s'agit d'un additif et dans la 4e, je peux sélectionner quel type d'additif c'est 'émulsifiant, stabilisant, etc ). Les listes de la quatrième colonne sont générées à l'aide d'un tableau dans la feuille data ou j'ai listé les types d'additif. Pour le moment cette liste est courte, mais elle pourrait croitre.
Ensuite, via une macro, ces informations sont répercutées dans un tableau sur le feuille Europe (AT35:AX50) et trié. 1er niveau de tri sur la colonne Status (décroissant pour avoir les ingrédients en premier puis les additifs), 2nd niveau de tris sur la colonne "Additifs cathegorie" (croissant pour avoir par ordre alphabétique), 3e niveau de tri sur la colonne "%" (décroissant) et 4e niveau de tri sur la colonne "Label EU" (par ordre croissant).
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim Ingredients As Range
Dim IngredientLabel As Range
Set Ingredients = Sheets("caloric Value").Range("Ingredient_percent_eu")
Set IngredientLabel = Sheets("Europe").Range("ingredient_label_eu")
If Not Application.Intersect(Ingredients, Range(Target.Address)) Is Nothing Then
IngredientLabel.Value = Range("Ingredient_percent_eu").Value
With Worksheets("Europe").ListObjects("Tableau10").Sort
.SortFields.Clear
.SortFields.Add Key:=Worksheets("Europe").Range("Tableau10[status]"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.SortFields.Add Key:=Worksheets("Europe").Range("Tableau10[Additif cathegorie]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Worksheets("Europe").Range("Tableau10[%]"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.SortFields.Add Key:=Worksheets("Europe").Range("Tableau10[Label EU]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
End If
End SubC'est à partir de là que je commence à avoir besoin de votre aide (enfin si vous avez des suggestions a faire sur le reste, distes moi ;-) ).
Il me faut récupérer le nom règlementaire de ces ingrédients et additifs afin de pouvoir faire la liste d’ingrédients et additifs du produit.
En utilisant la fonction personnalisée RechVTous, je viens récupérer successivement les ingrédients, puis les additifs par catégorie que je mets dans la cellule B26 de la feuille Nutrition Facts EU
Function RechVTous(v, champRech As Range, ChampRetour As Range, separateur)
a = champRech
temp = ""
For i = 1 To champRech.Count
If a(i, 1) = v Then
temp = temp & ChampRetour(i) & separateur
End If
Next i
RechVTous = Left(temp, Len(temp) - 1)
End Functionj'obtiens ainsi la formule suivante
=SIERREUR("INGREDIENTS"&" : "&rechvtous("Ingredient";Tableau10[status];Tableau10[Label EU];", ");"")&SIERREUR("EMULSIFYER"&" : "&rechvtous("Emulsifyer";Tableau10[Additif cathegorie];Tableau10[Label EU];", ");"")&" "&SIERREUR("GLAZING AGENT"&" : "&rechvtous("Glazing agent";Tableau10[Additif cathegorie];Tableau10[Label EU];", ");"") &" "&SIERREUR("STABILIZER"&" : "&rechvtous("Stabilizer";Tableau10[Additif cathegorie];Tableau10[Label EU];", ");"")Cette formule fonctionne pour le moment (ci-dessous le visuel), mais cette formule n'est pas évolutive. Si demain, je rajoute une catégorie d'additif, je dois rajouter une composante RechVTous et la placer au bon endroit afin de garder un classement par ordre alphabétique des classes d'additif.
Pourriez-vous m'aider a faire une formule ou bien une macro (qui pourrait faire appel ou intégrer la fonction RechVTous, ou pas d'ailleurs) qui permettrait de compiler les ingrédients puis les additifs en allant chercher la catégorie d'additif dans le tableau de la feuille data, tester la présence dans le tableau de la feuille Europe et si présent, compiler ensemble les éléments correspondant à cette catégorie d'additif?
Pour l'aspect classement par ordre alphabétique, je pense que je peux m'arranger pour conserver les catégories d'additif du tableau de la feuille data classé par ordre alphabétique.
Je vous remercie par avance pour votre aide
Bastien
edit :
L'autre point que j'ai oublié de mentionné, c'est que je constate que j'ai un separateur qui apparait en fin de liste malgrès la présence de la formulation qui en théorie évite cela. Si jamais il y avait la possibilité de les enlever, ça serait top :-)
RechVTous = Left(temp, Len(temp) - 1)