Algo transposition tableau VBA

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
R

richert90

XLDnaute Occasionnel
Bonjour,

J'ai un tableau initial (P.J) que je souhaite transposer dans un 2ième onglet d'Excel.
Je suis bloqué au niveau de l'algorithme qui me permet de transposer le tableau
L'onglet 3 d'Excel est l'aperçu du tableau final souhaité.

Merci de m'aider pour trouver comment faire...
(Vous pouvez voir le peu que j'ai fait en VBA pour transposer le tableau dans le module "transposition")

Merci d'avance
 

Pièces jointes

Trier par date Trier par votes
Re : Algo transposition tableau VBA

Bonjour pierrejean

En fait je ne m’intéresse qu'aux colonnes avec Gr1B01, Gr1B02, ... Gr2B01 etc... et Gr1B01 max etc...
Gr --> Groupe
B --> Board
Gr1B01 : Groupe 1 et Board 1
Les colonnes GR1 Avg, Gr2 Avg,etc... je les laisses de côté pour le moment

PS: le nombre de groupe et de board par groupe est variable, ici Groupe=3 et board=11 mais ça peut être différent d'où la difficulté de l'algo.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Algo transposition tableau VBA

Bonjour à tous.


Un essai :​
VB: 
Sub transposition_tableau()
Dim i&, j&, k&, v$, bs, bt, x, y, Champs(), b(), m(), Cel As Range

  Champs = Feuil1.[A1].Resize(1, Feuil1.[A1].End(xlToRight).Column - 2).Offset(0, 2).Value
  m = Array()
  b = Array()

  For i = 1 To UBound(Champs, 2)
    If Champs(1, i) Like "Gr*B* Max" Then
      ReDim Preserve m(UBound(m) + 1)
      m(UBound(m)) = Array(i, Champs(1, i))
    End If
  Next

  For i = 0 To UBound(m)
    v = Left$(m(i)(1), Len(m(i)(1)) - 4)
    For j = 1 To UBound(Champs, 2)
      If v = Champs(1, j) Then
        ReDim Preserve b(UBound(b) + 1)
        b(UBound(b)) = Array(j, Champs(1, j))
      End If
    Next
  Next

  With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With

  Feuil2.[A1].CurrentRegion.Offset(1).ClearContents
  For Each Cel In Feuil1.[A1].Resize(Feuil1.[A1].End(xlDown).Row - 1, 1).Offset(1).Cells
    bt = Cel.Value: bs = Cel.Offset(, 1).Value
    For i = 0 To UBound(b)
      x = Split(b(i)(1), "r")
      y = Split(x(1), "B")
      ReDim Preserve y(6)
      y(2) = bt: y(3) = bs
      y(4) = Cel.Offset(, b(i)(0) + 1).Value
      y(5) = Cel.Offset(, m(i)(0) + 1).Value
      k = k + 1
      Feuil2.[A1].Resize(1, 6).Offset(k).Value = y
    Next
  Next

  Set Cel = [A1].Resize(k, 6)
  With Feuil2.Sort
    With .SortFields
      .Clear
      .Add Key:=Cel.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
      .Add Key:=Cel.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
    End With
    .SetRange Cel.Cells
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With

  With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With

End Sub
C'est brut de fonderie : si ça convient, on pourra (peut-être) perfectionner la chose.​


Bonne soirée.


ℝOGER2327
#7079

Lundi 23 Sable 141 (Sainte Viole, vierge et martyre - fête Suprême Quarte)
3 Nivôse An CCXXII, 6,8654h - bitume
2013-W52-1T16:28:37Z
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Algo transposition tableau VBA

Bonjour à tous

une autre version:

Code: 
Private Sub Trans()
Dim TAblo, Tablo2
Dim NbElement As Integer, NbTablo2 As Integer
Dim x

x = 0
NbElement = Worksheets("dataBase").Range("A" & Rows.Count).End(xlUp).Row - 1

NbTablo2 = (NbElement) * 33
ReDim Tablo2(NbTablo2, 6)
TAblo =Worksheets("dataBase").Range("A1:BV6")

For i = 5 To UBound(TAblo, 2) Step 24
    For j = 0 To 21 Step 2
        For k = 2 To NbElement + 1
            Tablo2(x, 0) = Mid(TAblo(1, i + j), 3, 1)
            Tablo2(x, 1) = Right(TAblo(1, i + j), Len(TAblo(1, i + j)) - 4)
            Tablo2(x, 2) = TAblo(k, 1)
            Tablo2(x, 3) = TAblo(k, 2)
            Tablo2(x, 4) = TAblo(k, i + j)
            Tablo2(x, 5) = TAblo(k, i + j + 1)
            x = x + 1
        Next
    Next
Next
Worksheets("Aperçu").[A2].Resize(UBound(Tablo2, 1), UBound(Tablo2, 2)).Value2 = Tablo2
End Sub

avec des restrictions :
à adapter si le nombre de groupe augmente
à modifier si le nombre de board par groupe change

A+
 
Vote positif 0 Vote négatif
Re : Algo transposition tableau VBA

Bonjour ROGER2327,Paf

Merci pour vos réponses!!

Je me suis penché sur le code de ROGER2327 pour le moment et ça marche parfaitement!
J'ai juste 2 questions:
- Si le nombre de groupe et de carte change, ce code est-il toujours bon? ou faut-il modifier des choses ?
- Comment tu arrives à sortir ce code pareil? 😱 j'aurais jamais trouvé, c'est sur..

Paf, je vais regarder ce que tu m'a proposé 🙂

Merci beaucoup à vous en tout cas d'avoir pris le temps de m'aider 😉. C'était mon cadeau de Noel 😛
 
Vote positif 0 Vote négatif
Re : Algo transposition tableau VBA

Re,

juste une petite erreur de feuille en fin de code:
au lieu de
Worksheets("Aperçu").[A2].Resize(UBound(Tablo2, 1), UBound(Tablo2, 2)).Value2 = Tablo2

mettre
Worksheets("Transpose").[A2].Resize(UBound(Tablo2, 1), UBound(Tablo2, 2)).Value2 = Tablo2


A+
 
Vote positif 0 Vote négatif
Re : Algo transposition tableau VBA

Bonjour à tous,

Une solution assez simple par formules dans le fichier joint.

Elles utilisent les noms définis Base NTime NGr NBoard.

Edit : la seule condition est qu'il y ait le même nombre de "Boards" dans tous les Groupes.

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Algo transposition tableau VBA

Re...


richert90 à dit:
(...)
Je me suis penché sur le code de ROGER2327 pour le moment et ça marche parfaitement!
(...)
Cliquez pour agrandir...
Pourvu que cela dure !​
richert90 à dit:
(...)
- Si le nombre de groupe et de carte change, ce code est-il toujours bon? ou faut-il modifier des choses ?
(...)
Cliquez pour agrandir...
En principe, non, à condition que la dénomination des champs à prendre en compte respecte toujours la même structure :
  • "Gr*B* Max"
  • "Gr*B*"
où * est une suite de caractères "0", "1", "2", ..., "9".​
richert90 à dit:
(...)
- Comment tu arrives à sortir ce code pareil? 😱 j'aurais jamais trouvé, c'est sur..
(...)
Cliquez pour agrandir...
Des rames de papier, des brassées de crayons de papier, quelques brouettées de gommes blanches, beaucoup de pratique, un peu de jus de cervelle, du rhum, de la sueur et des larmes...


Quelques commentaires sur le code :​
VB: 
  For i = 1 To UBound(Champs, 2)
    If Champs(1, i) Like "Gr*B* Max" Then
      ReDim Preserve m(UBound(m) + 1)
      m(UBound(m)) = Array(i, Champs(1, i))
    End If
  Next
explore la ligne d'entête de l'onglet dataBase et relève le numéro de colonne et l'intitulé lorsqu'il est de la forme "Gr*B* Max".​
VB: 
  For i = 0 To UBound(m)
    v = Left$(m(i)(1), Len(m(i)(1)) - 4)
    For j = 1 To UBound(Champs, 2)
      If v = Champs(1, j) Then
        ReDim Preserve b(UBound(b) + 1)
        b(UBound(b)) = Array(j, Champs(1, j))
      End If
    Next
  Next
fait la même chose, en recherchant les intitulés de la forme "Gr*B*" correspondant aux "Gr*B* Max" trouvés précédemment.

La suite du code extrait les données correspondant aux champs identifiés ci-dessus, les colle dans l'onglet Transpose, puis effectue la mise en ordre des résultats.​


Bonne soirée.


ℝOGER2327
#7080

Lundi 23 Sable 141 (Sainte Viole, vierge et martyre - fête Suprême Quarte)
3 Nivôse An CCXXII, 7,2673h - bitume
2013-W52-1T17:26:29Z
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Algo transposition tableau VBA

Re-bonsoir à tous 🙂

(...)
- Si le nombre de groupe et de carte change, ce code est-il toujours bon? ou faut-il modifier des choses ?
(...)
En principe, non, à condition que la dénomination des champs à prendre en compte respecte toujours la même structure :

"Gr*B* Max"
"Gr*B*"
Cliquez pour agrandir...

--> Ça tombe bien, normalement la structure des champs sera toujours identique donc je pourrai utilisé le code que tu m'as fourni pour transposer le tableau 🙂.

Merci pour ces commentaires qui me font pas de mal 🙂

PS: Une dernière question, à partir de cette transposition, je vais faire un graphique en courbe avec en abscisse les dates avec les heures + les minutes, mais Excel affiche JJ/MM/AAAA 00:00 au lieu de l'heure indiqué dans les colonnes, c'est normal car c'est impossible à faire ou est-ce que ça se règle ?


Job75, je trouve aussi ta solution intéressante, suffit juste que j'applique en VBA la formule et c'est bon 🙂

paf, je vais essayer ta solution pour une autre base avec un nombre de groupe et de carte différent pour voir si j'ai bien compris


Merci à vous encore
 
Vote positif 0 Vote négatif
Re : Algo transposition tableau VBA

Re,

le presque même code avec quelques commentaires facilitant les modifs:
Code: 
Dim TAblo, Tablo2
Dim NbElement As Integer, NbTablo2 As Integer
Dim x, NbBoard

NbElement = Worksheets("dataBase").Range("A" & Rows.Count).End(xlUp).Row - 1 'Nb ligne par colonne
NbBoard = 11 'indique le nombre de board par group

NbTablo2 = (NbElement) * NbBoard * 3 'dimensionne le nombre d'élément du tableau final . 3 étant le nb de groupe
ReDim Tablo2(NbTablo2, 6)
TAblo = Worksheets("dataBase").Range("A1:BV6")
x = 0
' de la colonne 5 à fin de tableau (dernière colonne)
For i = 5 To UBound(TAblo, 2) Step NbBoard * 2 + 2  '**2 colonnes par board +2 colonnes AVG et MAX
    For j = 0 To NbBoard * 2 - 1 Step 2
        For k = 2 To NbElement + 1
            Tablo2(x, 0) = Mid(TAblo(1, i + j), 3, 1)
            Tablo2(x, 1) = Right(TAblo(1, i + j), Len(TAblo(1, i + j)) - 4)
            Tablo2(x, 2) = TAblo(k, 1)
            Tablo2(x, 3) = TAblo(k, 2)
            Tablo2(x, 4) = TAblo(k, i + j)
            Tablo2(x, 5) = TAblo(k, i + j + 1)
            x = x + 1
        Next
    Next
Next
Worksheets("Aperçu").[A2].Resize(UBound(Tablo2, 1), UBound(Tablo2, 2)).Value = Tablo2

Bonne suite
 
Vote positif 0 Vote négatif
Re : Algo transposition tableau VBA

Merci paf!

Je récupère le nombre de groupe et le nombre de carte par groupe depuis un fichier .ini (j'ai une fonction sur VBA me permettant de récupérer ces valeurs), il me suffit de les stocker dans des variables pou ensuite les mettre dans ton code où il faut. Donc ce code marche même si par exemple on un nombre différent de groupe et un nombre différent de carte ( mais toujours le même nombre de carte dans chacun des groupes!)? La ligne ci dessous ne risque pas de modifier la donne?

Code: 
For i = 5 To UBound(TAblo, 2) Step NbBoard * 2 + 2  '**2 colonnes par board +2 colonnes AVG et MAX
    For j = 0 To NbBoard * 2 - 1 Step 2
        For k = 2 To NbElement + 1
            Tablo2(x, 0) = Mid(TAblo(1, i + j), 3, 1)
            Tablo2(x, 1) = Right(TAblo(1, i + j), Len(TAblo(1, i + j)) - 4)
 
Vote positif 0 Vote négatif
Re : Algo transposition tableau VBA

richert90 à dit:
Job75, je trouve aussi ta solution intéressante, suffit juste que j'applique en VBA la formule et c'est bon 🙂
Cliquez pour agrandir...

Oui, et ce n'est pas très difficile :

Code: 
Sub Transpose()
Dim P As Range
Set P = [A2].Resize([NTime] * [NGr] * [NBoard], 6)
Application.ScreenUpdating = False
P.Columns(1).FormulaR1C1 = "=N(R[-1]C1)+NOT(MOD(ROW()-2,NTime*NBoard))"
P.Columns(2).FormulaR1C1 = "=IF(RC1<>R[-1]C1,1,R[-1]C+NOT(MOD(ROW()-2,NTime)))"
P.Columns(3).FormulaR1C1 = "=INDEX(dataBase!C1,MOD(ROW()-2,NTime)+2)"
P.Columns(4).FormulaR1C1 = "=INDEX(dataBase!C2,MOD(ROW()-2,NTime)+2)"
P.Columns(5).FormulaR1C1 = "=INDEX(OFFSET(Base,,,NTime+1),MOD(ROW()-2,NTime)+2,MATCH(""Gr""&RC1&""B""&TEXT(RC2,""00""),Base,0))"
P.Columns(6).FormulaR1C1 = "=INDEX(OFFSET(Base,,,NTime+1),MOD(ROW()-2,NTime)+2,MATCH(""Gr""&RC1&""B""&TEXT(RC2,""00"")&"" Max"",Base,0))"
P = P.Value
Range("A" & P.Rows.Count + 2 & ":F" & Rows.Count).ClearContents
End Sub
Fichiers (2).

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Algo transposition tableau VBA

Re,
Si les données nombre de groupe et de nombre de carte (board) sont déjà récupérées dans des variables, il suffit :

soit d'affecter ces valeurs aux variables du code fourni, sans toucher au reste du code:
NbBoard = LaVariable1 'indique le nombre de board par group
NbTablo2 = NbElement * NbBoard * LaVariable2

soit d'utiliser ces variables directement dans le code fourni,

NbTablo2 = NbElement * NbBoard * LaVariable2
For i = 5 To UBound(TAblo, 2) Step LaVariable1 * 2 + 2 '**2 colonnes par board +2 colonnes AVG et MAX
For j = 0 To LaVariable1 * 2 - 1 Step 2

dans tous les cas il faut adapter la définition de la plage de données:
Code: 
DerCol = Worksheets("dataBase").Cells(2, Columns.Count).End(xlToLeft).Column + 1
TAblo = Range(Worksheets("dataBase").Cells(1, 1), Worksheets("dataBase").Cells(NbElement + 1, DerCol))
au lieu de
Code: 
TAblo = Worksheets("dataBase").Range("A1:BV6")

A+
 
Vote positif 0 Vote négatif
Re : Algo transposition tableau VBA

Re,

Sur un grand tableau il est peut-être bon de passer en calcul manuel :

Code: 
Sub Transpose()
Dim P As Range
Set P = [A2].Resize([NTime] * [NGr] * [NBoard], 6)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
P.Columns(1).FormulaR1C1 = "=N(R[-1]C1)+NOT(MOD(ROW()-2,NTime*NBoard))"
P.Columns(2).FormulaR1C1 = "=IF(RC1<>R[-1]C1,1,R[-1]C+NOT(MOD(ROW()-2,NTime)))"
P.Columns(3).FormulaR1C1 = "=INDEX(dataBase!C1,MOD(ROW()-2,NTime)+2)"
P.Columns(4).FormulaR1C1 = "=INDEX(dataBase!C2,MOD(ROW()-2,NTime)+2)"
P.Columns(5).FormulaR1C1 = "=INDEX(OFFSET(Base,,,NTime+1),MOD(ROW()-2,NTime)+2,MATCH(""Gr""&RC1&""B""&TEXT(RC2,""00""),Base,0))"
P.Columns(6).FormulaR1C1 = "=INDEX(OFFSET(Base,,,NTime+1),MOD(ROW()-2,NTime)+2,MATCH(""Gr""&RC1&""B""&TEXT(RC2,""00"")&"" Max"",Base,0))"
P = P.Value
Range("A" & P.Rows.Count + 2 & ":F" & Rows.Count).ClearContents
Application.Calculation = xlCalculationAutomatic
End Sub
A vérifier car je ne suis pas sûr que c'est nécessaire.

Fichiers (3).

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

D
  • Question Question
XL 2013 Codage VBA
Réponses
6
Affichages
323
Oneida
Oneida
nightswan
  • Résolu(e)
Microsoft 365 Récupération d'une valeur particulière dans un tableau...
Réponses
13
Affichages
416
nightswan
nightswan
Lu76Fer
  • Résolu(e)
XL 2016 XLS - Comment déterminer les zones présentent au niveau d'une cellule ?
Réponses
2
Affichages
851
Lu76Fer
Lu76Fer
F
  • Résolu(e)
Microsoft 365 Transposer un tableau
Réponses
7
Affichages
673
Fybu13
F
jeff1494
  • Résolu(e)
XL 2021 Une aide pour optimiser du code VBA
2
Réponses
16
Affichages
707
jeff1494
jeff1494
L
  • Résolu(e)
Power Query Dépivoter colonnes dans PowerQuery
Réponses
7
Affichages
1 K
job75
job75
D
  • Question Question
XL 2021 3 problèmes : Bouton VBA (fusion et suppression) & doublons
Réponses
4
Affichages
788
Dubuyz1
D
S
  • Résolu(e)
Microsoft 365 Tableau Gestion flotte automobile
Réponses
10
Affichages
1 K
selim sloumi
S
A
  • Résolu(e)
XL 2019 VBA newbie
4 5 6
Réponses
80
Affichages
4 K
apocalypse
A
rastafouette
  • Question Question
Microsoft 365 "concatener" certaines colonnes d'onglets
2
Réponses
15
Affichages
1 K
Phil69970
Phil69970
T
  • Résolu(e)
XL 2019 Problème tableau structuré et code vba
2
Réponses
28
Affichages
2 K
Cousinhub
Cousinhub
A
  • Question Question
Microsoft 365 INDEX+EQUIV dont le resultat duplique les lignes par erreur
Réponses
5
Affichages
480
aeca
A
MBax
  • Résolu(e)
Microsoft 365 Extraction d'informations sur différents onglets en partant d'une base de données
Réponses
7
Affichages
831
MBax
MBax
Calvus
  • Question Question
Microsoft 365 Recherche incomplète planning (problème de dates)
Réponses
13
Affichages
812
p56
p56
S
  • Résolu(e)
Microsoft 365 Appliquer par vba une mise en forme conditionnelle d'après une liste de cellules mises en forme
Réponses
9
Affichages
919
Dranreb
Dranreb
V
  • Question Question
Microsoft 365 Macro de réinitialisation
Réponses
1
Affichages
640
Eric KERGRESSE
E
M
  • Question Question
Microsoft 365 Programme VBA excel
Réponses
6
Affichages
552
mimilapino09
M
oguruma
EXCEL :: VBA :: Activer - Désactiver les filtres dans un tableau en plage d'adresses ou dans un tableau structuré
Réponses
0
Affichages
624
oguruma
oguruma
M
  • Question Question
XL 2021 VBA pour un journal de comptabilité
Réponses
5
Affichages
1 K
manzol
M
A
  • Question Question
XL 2016 tableau de bord dynamique
Réponses
8
Affichages
1 K
ami1
A
Retour