XL 2010 Reconstruire un tableau

cathodique · 18 Avril 2024

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.

sylvanu · 18 Avril 2024

Oneida à dit:
J'attends de voir comment sylvanu va traiter votre sujet

C'est de l'abus ou un challenge ?

Un essai en PJ avec :

VB:

Sub Worksheet_Activate()
Application.ScreenUpdating = False
Dim T, Tsortie, TabloTransfert, DL%, DLS%, N%, L%
TabloTransfert = Array(0, 8, 7, 1, 2, 3, 4, 5, 6, 9) ' Array de permutation de champs tableau de sortie vs tableau entrée.
ReDim Tsortie(1 To 10000, 1 To 9)                   ' Tableau de sortie, gde taille par défaut
T = [TbS]                                           ' Transfert tableau dans array
DLS = 0                                             ' Init N° ligne écriture dans array de sortie Tsortie
For DL = 1 To UBound(T)                             ' Pour toutes les lignes du tableau
    DLS = DLS...

Oneida · 18 Avril 2024

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 · 18 Avril 2024

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

VB:

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 · 18 Avril 2024

patricktoulon à dit:

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

VB:

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 · 18 Avril 2024

@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 · 18 Avril 2024

patricktoulon à dit:
@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 · 20 Avril 2024

patricktoulon à dit:

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

VB:

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.

XL 2010 Reconstruire un tableau

cathodique

XLDnaute Barbatruc

Pièces jointes

sylvanu

Oneida

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

Oneida

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

Oneida

XLDnaute Impliqué

cathodique

XLDnaute Barbatruc

Discussions similaires