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! ) pour recalcul global?

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+

16assortiments.xlsm (23.35 Ko)

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

Rechercher des sujets similaires à "recherchev deux criteres supprimer valeurs identiques"