XL 2010 Cellule Multi donnée(Résolu)

Kael_88

XLDnaute Occasionnel
Le forum,

je me tourne vers vous car je sèche sur 2 problèmes,

Problème 1:
Après appui sur Bouton Tri en page 3,dans une même cellule j'ai plusieurs nom,
je voudrai, s'il y a que le même nom en colonne 2, qu'il n'en mette qu'un, et s'il y a plusieurs nom différent, qu'il n'y touche pas.

Problème 2:
Après appui sur Bouton Tri en page 3, une recherche est faite sur un autre onglet, mais s'il y a plusieurs nom en colonne 2 dans la cellule de recherche, il ne les prend pas en compte, or je voudrai qu'il les prenne pour mettre les prix U en face de chaque nom en cellule 4.

Cordialement
 

Pièces jointes

  • Multi.xlsm
    24.4 KB · Affichages: 29

job75

XLDnaute Barbatruc
Bonjour Kael_88,

Utilisez cette macro :
Code:
Sub Complement()
Dim t, d As Object, i&, s, x$, j&, k&
t = Sheets("Element").[B1].CurrentRegion.Resize(, 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t): d(t(i, 1)) = t(i, 2): Next
With Sheets("Traitement").[B1].CurrentRegion.Resize(, 4)
    t = .Value
    For i = 2 To UBound(t)
        s = Split(t(i, 1), vbLf)
        If UBound(s) > 0 Then
            x = s(0)
            t(i, 4) = d(x)
            For j = 1 To UBound(s)
                If s(j) <> x Then
                    For k = 1 To UBound(s)
                        t(i, 4) = t(i, 4) & vbLf & d(s(k))
                    Next k
                    GoTo 1
                End If
            Next j
            t(i, 1) = x
            t(i, 3) = Evaluate(Replace(t(i, 3), vbLf, "+"))
        End If
1   Next i
    .Value = t 'restitution
End With
End Sub
Vous pouvez bien sûr l'appeler à la fin de la macro MàJ_Gest_Emp.

A+
 
Dernière édition:

Kael_88

XLDnaute Occasionnel
Le Forum, @job75 ,

Super, merci,
Petit bémol, quand il ne laisse qu'un nom en colonne B, il fait l'addition colonne D, peut on ne pas y toucher?

autrement cela correspond à ma demande, merci.

J'ai aussi la colonne A, a faire comme la B, que dois je modifier pour y arriver ?

Si pas trop demandé, pouvez vous commenter les lignes, svp, afin de comprendre et de mieux l'adapter, merci.

Cordialement
 

job75

XLDnaute Barbatruc
Bonjour Kael_88,
Petit bémol, quand il ne laisse qu'un nom en colonne B, il fait l'addition colonne D, peut on ne pas y toucher?
Vous ne lisez pas le code ! Supprimez t(i, 3) = Evaluate(Replace(t(i, 3), vbLf, "+"))
J'ai aussi la colonne A, a faire comme la B, que dois je modifier pour y arriver ?
Sans doute prévoir dans la feuille "Master" les données à y entrer !

Bonne journée.
 

Kael_88

XLDnaute Occasionnel
Le Forum, @job75 ,

Merci de ton retour,
J'avais passer cette ligne en commentaire justement, donc cela me le confirme bien.
je rejoints le fichier avec modification des colonnes au bon endroits(comme le fichier original) ainsi que votre code, ainsi que des données dans la colonne B.

merci de me dire si c'est bon est faire avec la Colonne B, la même que la colonne A.

Cordialement
 

Pièces jointes

  • Multi 2.xlsm
    29.6 KB · Affichages: 23

job75

XLDnaute Barbatruc
Bonjour Kael_88,

Dans la mesure où un doublon en colonne A entraîne forcément un doublon en colonne B, il suffit d'ajouter une ligne :
Code:
Sub Complement()
Dim t, d As Object, i&, s, x$, j&, k&
t = Sheets("Element").[A1].CurrentRegion.Resize(, 4)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t): d(t(i, 1)) = t(i, 4): Next
With Sheets("Traitement").[A1].CurrentRegion.Resize(, 8)
    t = .Value
    For i = 1 To UBound(t)
        s = Split(t(i, 1), vbLf)
        If UBound(s) > 0 Then
            x = s(0)
            t(i, 7) = d(x)
            For j = 1 To UBound(s)
                If s(j) <> x Then
                    For k = 1 To UBound(s)
                        t(i, 7) = t(i, 7) & vbLf & d(s(k))
                    Next k
                    GoTo 1
                End If
            Next j
            t(i, 1) = x
            t(i, 2) = Split(t(i, 2), vbLf)(0)
        End If
1   Next i
    .Value = t 'restitution
End With
End Sub
A+
 

Statistiques des forums

Discussions
311 723
Messages
2 081 932
Membres
101 844
dernier inscrit
pktla