Créer autant de lignes par rapport à une liste de valeurs

Bonjour tout le monde.

Je ne connais pas du tout le VBA mais j'ai un besoin urgent de faire une macro.

Voilà mon besoin :

J'ai une première liste avec des user et une valuer "groupe associée" :

J'ai une autre liste associée qui donne plusieurs valeurs à la valeur "Groupe":

Et voici le résultat que je voudrais :

Un tableau qui répète autant de lignes qu'il y a de valeurs associées à la cellule "groupe".

Merci beaucoup si vous savez le code VBA pour ça...

Peggy

Bonjour

Un fichier est TOUJOURS le bienvenu…

Ci joint ma solution par macro

A+ François

Bonjour peggyd, fanfan38, le forum,

Une variante.....(merci à AlgoPlus pour sa fonction perso, )....

Cordialement,

Bonjour et bienvenue,

Tu aurais pu décliner ta version Excel.

Une proposition Power Query (récupérer et transformer).

Complément gratuit Microsoft poue Excel 2010 et 2013. Natif pour les versions ultérieures.

Cdlt.

Merci beaucoup à tous pour vos réponses.

La résultat qui se rapproche le plus est la réponse de xorsankukai (fanfan38).. Sauf que je ne voudrais pas avoir les valeurs dans une même cellule mais autant de lignes que de valeurs, c'est-à-dire un résultat comme ça (je joins le fichier excel) :

Jean-Eric, Malheureusement je n'ai pas powerquery...

Peggy

Bonjour

J'ai supprimé le groupe

A+ François

Merci beaucoup François de ta réponse. Mais ce n'est pas le résultat que je souhaite... J'ai joint en PJ le résultat attendu.

La macro attendue est plus celle de xorsankukai , sauf que je voudrais une ligne par valeur, et non pas l'ensemble des valeurs dans une cellule...

Merci beaucoup à tous pour votre aide.

Bonjour,

@peggy,

Quelle est ta version Excel ?

Cdlt.

Bonsoir tout le monde,

Un essai......pas optimisé .....mais comme Jean-Eric est dans les parages, une meilleur proposition ne devrait pas tarder...

Cordialement,

Bonsoir à tout le monde,

Et sinon, via formules toutes simples pour rigoler :

=INDEX(TbUser[User];EQUIV(INDEX(TbValeur[Groupe];EQUIV(I11;TbValeur[valeurs];0));TbUser[Groupe];0))

à mettre en H11.

Bonjour,

Une autre proposition VBA.

Cdlt.

Public Sub CombineTables()
Dim lo As ListObject
Dim tbl As Range, tbl2 As Range
Dim Cell As Range, Cell2 As Range, r As Range
Dim arr() As Variant, n As Variant
Dim lrow As Long, k As Long

    Set tbl = Range("TbUser")
    Set tbl2 = Range("tbValeur")
    lrow = tbl2.Rows.Count
    ReDim arr(1 To lrow, 1 To 2)
    Set lo = Range("TbResultat").ListObject

    With lo
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
        Set r = .InsertRowRange.Cells(1)
    End With

    For Each Cell In tbl.Columns(2).Cells
        On Error Resume Next
        n = Application.Match(Cell.Value, tbl2.Columns(1), 0)
        If Not IsError(n) Then
            For Each Cell2 In tbl2.Columns(1).Cells
                If Cell2.Value = Cell.Value Then
                    k = k + 1
                    arr(k, 1) = Cell.Offset(, -1).Value    'User
                    arr(k, 2) = Cell2.Offset(, 1).Value    'Valeur
                End If
            Next Cell2
        End If
    Next Cell

    If k > 0 Then r.Resize(k, 2).Value = arr

End Sub

Bonjour à tous,

@Jean-Eric :

Au départ , j'étais parti sur ce code

Sub Macro1()
 Dim lig As Long, tablo, tabloR(), k As Long, i As Long

  With Sheets("Feuil1")

   tablo = .ListObjects("TbValeur").DataBodyRange

    k = 0
    For i = 1 To UBound(tablo, 1)
     If Not .Range("TbUser[Groupe]").Find(what:=tablo(i, 1)) Is Nothing Then
      ReDim Preserve tabloR(1 To 2, 1 To k + 1)
        tabloR(1, 1 + k) = Application.Index(.Range("TbUser[User]"), Application.Match(tablo(i, 1), .Range("TbUser[Groupe]"), 0))
        tabloR(2, 1 + k) = tablo(i, 2)
    k = 1 + k
     End If
    Next i
         With .ListObjects("TbResultat")
          If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
            .ListRows.Add
             lig = .ListColumns("User").Range.Find("", SearchDirection:=xlNext).Row
         End With
          On Error Resume Next
             .Range("H" & lig).Resize(UBound(tabloR, 2), 2) = Application.Transpose(tabloR): Erase tabloR
   End With
End Sub

J'obtenais bien le résultat souhaité, mais j'ai pris le problème à l'envers, je suis parti du TbValeur pour rechercher la correspondance dans le TBUser.

Ensuite, je me suis un peu perdu dans mon raisonnement, que faire si:

• un User n'a pas de groupe?
• un User a un groupe qui n'est pas répertorié ?

D'où ma proposition un peu alambiquée, je ne suis pas parvenu à tout traiter en une fois d'où l'utilisation de 2 "tablo",

Peggyd n'a pas précisé si cela était possible, mais si tel était le cas, comment gèrerais-tu cela ?

C'est toujours un plaisir de te lire,

Amitiés,

Merci beaucoup à tous ! C'est exactement ça que je voulais. Les derniers fichiers XMl envoyés.

Merci notamment à xorsankukai et Jean-Eric.

Vous êtes tous génial, vous êtes mes sauveurs :)

Encore mille mercis !