XL 2013 plusieurs choix sur la meme ligne

[jtsfab]

Bonjour,
Les années passent mais les difficultés sur excel demeurent .
Une nouvelle fois je fais appel a vos competences .
J'ai un fichier avec 2 onglets .
Les deux fichiers sont liés suivant le "groupe" . D'habitude je fais du recherche V mais cette fois impossible car j'ai des resultats multiple . Pour un meme groupe je peux avoir plusieurs Lieux et couleur .
Je souhaiterais dans un 3eme onglet " restit" , avoir suivant le groupe les differents lieux et couleur possible , sur la meme ligne .
J'ai fait un exemeple dans restit , j'espere que mes explications sont assez clairs . Ce qui est moins sur
Merci d'avance et Bonne année

 

[vgendron]

Bonjour
en effet.. pas très clair

Dans ta feuille Donnée
pour le groupe1, il y a 4 lignes: A-Bleu / D-Vert / F-noir / G-Jaune
pour le groupe2, il y a 2 lignes: B-Vert / E-Vert
pour le groupe3, il y a 1 ligne: C-Orange
pour le groupe4, i y a 1 iigne: H-bleu

donc.. dans la feuille Restit
je dois récupérer 4 lignes (= 4 groupes)
sur la ligne 1 (groupe1): je dois voir 4*2=8 colonnes..
sur le ligne 2 (group2); je dois voir 2*2=5 colonnes...

pourquoi pour le groupe 1, il semble que je retrouve 2 fois la ligne?? quel est le lien manquant avec la feuille "donnée1" ?

 

[vgendron]

bon. j'ai bien frotté ma boule de cristal et voila ce que ca donne

Sub Restit()
Dim TabDonnée() As Variant
Set Dicogroupe = CreateObject("Scripting.dictionary")
With Sheets("Donnée")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    TabDonnée = .Range("A4:D" & fin).Value
End With
For i = LBound(TabDonnée, 1) To UBound(TabDonnée, 1)
    If Not Dicogroupe.exists(TabDonnée(i, 3)) Then
        Dicogroupe.Add TabDonnée(i, 3), TabDonnée(i, 1) & "/" & TabDonnée(i, 2)
    Else
        Dicogroupe(TabDonnée(i, 3)) = Dicogroupe(TabDonnée(i, 3)) & "/" & TabDonnée(i, 1) & "/" & TabDonnée(i, 2)
    End If
Next i
With Sheets("donnée 1")
    fin2 = .Range("A" & .Rows.Count).End(xlUp).Row
    For Each groupe In .Range("B2:B" & fin2)
        If Dicogroupe.exists(groupe.Value) Then
            tablo = Split(Dicogroupe(groupe.Value), "/")
            groupe.Offset(0, 1).Resize(1, UBound(tablo) + 1) = tablo 'Dicogroupe(groupe.Value)
        End If
    Next groupe
End With
End Sub

 

[jtsfab]

Merci vgendron,

c'est tout a fait cela .
Seul bemol , dans donnée 1 , le tableau est bq plus grand , j'ai d'autre donnée apres . Peux tu m'expliquer comme mettre le resultat de la macro sur la colonne que je veux et non pas commencé en colonne C ?

Dans tous le cas merci pour ton aide , rapide et efficace malgré des explications foireuse .

 

[vgendron]

C'est cette ligne qu'il faut changer
groupe.Offset(0, 1).Resize(1, UBound(tablo) + 1) = tablo 'Dicogroupe(groupe.Value)

Groupe est dans la colonne B

groupe.offset(0,1) décale d'une colonne (et 0 ligne) ==> colonne​

 

[jtsfab]

merci , nickel

 

[vgendron]

bon. je fini mon message.. mon clavier s'est mis en grève d'un coup....??;

donc.. colonne C
tu peux aussi utiliser
.range("E" & groupe.row)
à la place de groupe.offset(0,3)

 

[jtsfab]

Merci encore vgendron , ca marche nickel . Un petit bemol tout de fois . J'ai des données entre la colonne B et la colonne E suivant ton exemple . Mais ceux ci s'efface quand je lance la macro . Je crois avoir 31 colonnes entre la colonne B et là où je veux que le resultat apparaisse . Mais je souhaite garder les infos entre B et la 31 colonnes . Possible ?

 

[vgendron]

hello
suffit de ne pas effacer... enfin. je crois.. à tester sur ton fichier

Sub Restit()


Dim TabDonnée() As Variant
Set Dicogroupe = CreateObject("Scripting.dictionary")

With Sheets("Donnée")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    TabDonnée = .Range("A4:D" & fin).Value
End With

For i = LBound(TabDonnée, 1) To UBound(TabDonnée, 1)
    If Not Dicogroupe.exists(TabDonnée(i, 3)) Then
        Dicogroupe.Add TabDonnée(i, 3), TabDonnée(i, 1) & "/" & TabDonnée(i, 2)
    Else
        Dicogroupe(TabDonnée(i, 3)) = Dicogroupe(TabDonnée(i, 3)) & "/" & TabDonnée(i, 1) & "/" & TabDonnée(i, 2)
    End If
Next i

With Sheets("donnée 1")
    .Activate
    fin2 = .Range("A" & .Rows.Count).End(xlUp).Row
    '.UsedRange.Offset(0, 2).Clear
    For Each groupe In .Range("B2:B" & fin2)
        If Dicogroupe.exists(groupe.Value) Then
            tablo = Split(Dicogroupe(groupe.Value), "/")
            groupe.Offset(0, 31).Resize(1, UBound(tablo) + 1) = tablo 'Dicogroupe(groupe.Value)
        End If
    Next groupe
   
End With

End Sub