XL 2010 Reconstruire un tableau

[cathodique]

Bonjour,

Dans le fichier joint feuille bd, la copie d'un tableau structuré de mon fichier de travail alimenté via un formulaire.
en colonne G et H donnée obtenu avec un saut de ligne (le caractère utilisé dans le code de transfert est Chr(10)).
Je voudrai obtenir le tableau de la feuille résultat. La consultation du fichier sera plus explicite.
tableau départ

tableau résultat

En vous remerciant.

 

[Oneida]

Re,
Derniere discution.
J'ai tres bien compris votre demande depart.
Je suis desole, mais la logique veux qu'il faille modifer le code de votre formulaire de facon a avoir directement le bon format de tableau en non pas creer un code de ratrappage
Bye

 

[patricktoulon]

Bonjour
perso même si je rejoins @Oneida dans son raisonnement
je te propose de travailler directement le tableau structuré sans passer par une feuille ou tableau intermédiaire
alors attention ça va très vite ça pique un peu les yeux

Sub transformation()
    Dim tbl, tablo, Lig&, Q&, A&, C, Ids, NdosS, Colonnes, LigneS
    With Range("tbs[#all]")
        tablo = .Value
        ReDim tbl(1 To UBound(tablo) * 10, 1 To UBound(tablo, 2))
        For Lig = 1 To UBound(tablo)
            Ids = Split(tablo(Lig, 8), Chr(10))
            NdosS = Split(tablo(Lig, 7), Chr(10))
            For Q = 0 To UBound(Ids)
                A = A + 1
                For C = 1 To UBound(tablo, 2)
                    tbl(A, C) = tablo(Lig, C)
                    tbl(A, 8) = Ids(Q)
                    tbl(A, 7) = NdosS(Q)
                Next
            Next
        Next
        
        Colonnes = Array(8, 7, 1, 2, 3, 4, 5, 6, 9) 'matrice  colonns(ordre différent)
        LigneS = Evaluate("ROW(1:" & A & ")") 'matrice de lignes
        tbl = Application.Index(tbl, LigneS, Colonnes) 'restructuration du tableau avec les matrices(nouvel ordre)
        
        'on envoie la sauce  dans la cells(1)redimentionnée  du tableau
        With .Cells(1, 1).Resize(A, 9): .Value = tbl: .HorizontalAlignment = xlCenter: End With
    
    'comme le tableau structuré a été supprimé on reconverti cette plage en tableau du même nom
    .Parent.ListObjects.Add(xlSrcRange, .Cells(1, 1).Resize(A, 9), , xlYes).Name = "TbS"
   MsgBox "Et c'est encore un militaire qui gagne une tringle  à  rideau" & vbCrLf & " LOL !!"
    End With
End Sub

 

[Oneida]

Bonjour
perso même si je rejoins @Oneida dans son raisonnement
je te propose de travailler directement le tableau structuré sans passer par une feuille ou tableau intermédiaire
alors attention ça va très vite ça pique un peu les yeux
Regarde la pièce jointe 1195286

Sub transformation()
    Dim tbl, tablo, Lig&, Q&, A&, C, Ids, NdosS, Colonnes, LigneS
    With Range("tbs[#all]")
        tablo = .Value
        ReDim tbl(1 To UBound(tablo) * 10, 1 To UBound(tablo, 2))
        For Lig = 1 To UBound(tablo)
            Ids = Split(tablo(Lig, 8), Chr(10))
            NdosS = Split(tablo(Lig, 7), Chr(10))
            For Q = 0 To UBound(Ids)
                A = A + 1
                For C = 1 To UBound(tablo, 2)
                    tbl(A, C) = tablo(Lig, C)
                    tbl(A, 8) = Ids(Q)
                    tbl(A, 7) = NdosS(Q)
                Next
            Next
        Next
       
        Colonnes = Array(8, 7, 1, 2, 3, 4, 5, 6, 9) 'matrice  colonns(ordre différent)
        LigneS = Evaluate("ROW(1:" & A & ")") 'matrice de lignes
        tbl = Application.Index(tbl, LigneS, Colonnes) 'restructuration du tableau avec les matrices(nouvel ordre)
       
        'on envoie la sauce  dans la cells(1)redimentionnée  du tableau
        With .Cells(1, 1).Resize(A, 9): .Value = tbl: .HorizontalAlignment = xlCenter: End With
   
    'comme le tableau structuré a été supprimé on reconverti cette plage en tableau du même nom
    .Parent.ListObjects.Add(xlSrcRange, .Cells(1, 1).Resize(A, 9), , xlYes).Name = "TbS"
   MsgBox "Et c'est encore un militaire qui gagne une tringle  à  rideau" & vbCrLf & " LOL !!"
    End With
End Sub

Salut, ca roule?

 

[patricktoulon]

@bonjour @Oneida
impec pour moi
je suis d'accords avec toi le tableau aurait du être construit dès le départ comme ça

bon ça m'a permis de jouer un peu avec des matrices et index c'est rogolo

 

[Oneida]

@bonjour @Oneida
impec pour moi
je suis d'accords avec toi le tableau aurais du etre construit dès le depart comme ça

bon ca m'a permi de jouer un peut avec des matrices et index c'est rogolo

Ne jamai louper une occasion de rigoler

 

[cathodique]

Bonjour
perso même si je rejoins @Oneida dans son raisonnement
je te propose de travailler directement le tableau structuré sans passer par une feuille ou tableau intermédiaire
alors attention ça va très vite ça pique un peu les yeux
Regarde la pièce jointe 1195286

Sub transformation()
    Dim tbl, tablo, Lig&, Q&, A&, C, Ids, NdosS, Colonnes, LigneS
    With Range("tbs[#all]")
        tablo = .Value
        ReDim tbl(1 To UBound(tablo) * 10, 1 To UBound(tablo, 2))
        For Lig = 1 To UBound(tablo)
            Ids = Split(tablo(Lig, 8), Chr(10))
            NdosS = Split(tablo(Lig, 7), Chr(10))
            For Q = 0 To UBound(Ids)
                A = A + 1
                For C = 1 To UBound(tablo, 2)
                    tbl(A, C) = tablo(Lig, C)
                    tbl(A, 8) = Ids(Q)
                    tbl(A, 7) = NdosS(Q)
                Next
            Next
        Next
      
        Colonnes = Array(8, 7, 1, 2, 3, 4, 5, 6, 9) 'matrice  colonns(ordre différent)
        LigneS = Evaluate("ROW(1:" & A & ")") 'matrice de lignes
        tbl = Application.Index(tbl, LigneS, Colonnes) 'restructuration du tableau avec les matrices(nouvel ordre)
      
        'on envoie la sauce  dans la cells(1)redimentionnée  du tableau
        With .Cells(1, 1).Resize(A, 9): .Value = tbl: .HorizontalAlignment = xlCenter: End With
  
    'comme le tableau structuré a été supprimé on reconverti cette plage en tableau du même nom
    .Parent.ListObjects.Add(xlSrcRange, .Cells(1, 1).Resize(A, 9), , xlYes).Name = "TbS"
   MsgBox "Et c'est encore un militaire qui gagne une tringle  à  rideau" & vbCrLf & " LOL !!"
    End With
End Sub

Bonjour @patricktoulon ,

Je te remercie beaucoup (tu en as fait un paquet pour m'aider).
Je m'excuse pour ma tardive réponse. J’étais très occupé.
Tu partages l'avis de @Oneida , je respecte.
Cependant, J'aurais aimé voir sa solution si je n'avais pas (par honnêteté) précisé que le tableau en question était alimenté via un formulaire.

Encore merci, pour tout.