Recherchev deux critères et supprimer des valeurs identiques
Bonsoir à tous,
J'espère que je trouverai une solution à un problème que j'essaye de résoudre depuis 3h. Mon niveau en excel est débutant.
J'ai une liste de biscuits qui sont chacun composé de x ingrédients. Dans l'exemple qui se trouve ci-joint, il n'y a que 2 biscuits.
J'aimerais par l'intermédiaire d'une recherchev, regrouper les ingrédients de mes deux biscuits tout en supprimant ceux qui se répètent afin de pouvoir créer l'étiquette de mon assortiment 1.
J'espère m'être fait comprendre et je vous remercie d'avance pour votre aide.
Bien à vous,
Antoine
Bonjour Anhels,
voici une première mouture de ton fichier avec mon petit bouton rouge habituel!
Il va falloir cadenasser tout ça et se mettre d'accord sur des procédures!
J'imagine que ton fichier de travail se présente différemment!? Il va falloir adapter le code!
- les ingrédients choisis pour l'élaboration des listes d'ingrédients de tes biscuits devraient, dans l'idéal, provenir d'une liste de validation, histoire d'être certain de leur stricte similitude au travers des différents produits.
Choisis donc bien tes mots et leur présentation. Par exemple, 'Farine de blé' : pourquoi une majuscule? Si, par inadvertance, cet ingrédient se retrouve au milieu de la liste...
- peut-on limiter le calcul à l'assortiment qui subit un changement? Faut-il laisser le petit bouton rouge (ou un autre système, hein!
Bref, à toi à cerner tes habitudes de travail pour que cette macro t'apporte un max d'efficacité!
Private Sub cmdAssort_Click()
'
Dim wks1 As Worksheet
Dim rCel As Range
'
Set wks1 = Worksheets("Ingrédients")
'
Dim tBase
Dim tItems
'
iRow = Range("B" & Rows.Count).End(xlUp).Row
iRow1 = wks1.Range("A" & Rows.Count).End(xlUp).Row
'
For x = 1 To iRow
If Cells(x, 1) <> "" Then
'calcul du nbre de biscuits dans l'assortiment en cours
iFlag1 = x
Cells(iFlag1, 3) = ""
For y = x + 1 To iRow
If Cells(y, 1) <> "" Or y = iRow Then
iFlag2 = IIf(y = iRow, iRow, y - 1)
Exit For
End If
Next
'recherche des ingrédients et calcul
For y = iFlag1 To iFlag2
'recherche du biscuit dans INGREDIENTS...
sFlag = Cells(y, 2)
Set rCel = wks1.Range("A2:A" & iRow1).Find(what:=sFlag, lookat:=xlWhole, searchdirection:=xlNext)
'... et de sa recette
sFlag1 = rCel.Offset(0, 1).Value
'si premier biscuit de l'assortiment
If y = iFlag1 Then
Cells(iFlag1, 3) = sFlag1
Else
'sinon, scan des ingrédients actuels
tBase = Split(Cells(iFlag1, 3), ", ")
'scan de la recette du biscuit en cours
tItems = Split(sFlag1, ", ")
For Z = 0 To UBound(tItems)
iFlag = 0
For k = 0 To UBound(tBase)
'si même ingrédient -> iFlag = 1
If tItems(Z) = tBase(k) Then
iFlag = 1
Exit For
End If
Next
'si ingrédient inconnu, on l'ajoute à l'étiquette de l'assortiment
If iFlag = 0 Then Cells(iFlag1, 3) = Cells(iFlag1, 3) & ", " & tItems(Z)
Next
End If
Next
End If
Next
'
End Sub
A te lire,
A+
Bonjour Curulis,
Un grand merci pour ta rapide réponse.
Malheureusement comme je l'ai signalé dans mon premier message, je suis un débutant en excel et donc j'aurai probablement quelques petites questions pour toi dans nos futures conversations
Voici la première: peux-tu me dire à quoi correspond ton petit bouton rouge et comment le faire fonctionner ?
Je vais t'envoyer une partie de mon fichier comme ça tu vois exactement ce dont j'ai besoin et comment mon fichier est construit actuellement.
Comme tu le verras, mes ingrédients proviennent d'une liste de validation.
Quant aux majuscules, je peux les enlever. Je les avais mises pour le coté esthétique sur les étiquettes.
J'ai mis entre parenthèses les feuilles de calcul que j'avais envoyées dans mon premier. Les noms des nouvelles feuilles correspondent à la structure de mon fichier actuelle.
J'espère que tu me comprendras
Si tu vois des moyens d'améliorer des points n'hésites pas à me les signaler.
Je te remercie.
Bien à toi,
Antoine