XL 2010 Transposer partiellement un fichier

[julien6337]

Bonjour,
je souhaite réaliser une transposition partielle d'un tableau d'aide
le tableau initial recense une liste de personnes à qui sont affectées des aides quotidienne de lundi au vendredi (voir fichier joint)
J'essaie d'obtenir un second tableau ou l'on retrouverait par jour (première colonne) les taches et noms de de chacun. (voir fichier joint)
l'exemple fourni n'est qu'un extrait, je parviens à faire des transposition plus globale que celle ci
Merci d'avance pour votre aide

 

[job75]

Bonjour julien6337,

Dans le fichier joint le 2ème tableau est un tableau structuré (menu Insertion => Tableau).

Formule matricielle en E2, à valider par Ctrl+Maj+Entrée et tirer sur E2:H5 :

=SIERREUR(INDEX(Tableau1[Aide];EQUIV(E$1&$A2&$B2&$C2;Tableau1[Jour]&Tableau1[[Nom ]]&Tableau1[Prénom]&Tableau1[Classe];0));"")

A+

 

[julien6337]

Merci beaucoup pour ce retour si rapide,
je n'ai pas été suffisamment précis dans ce que je recherche du coup ça fonctionne mais ne répond pas complètement à mes attentes.

EN fait j'ai un tableau sous la forme de mon tableau situé de A1 à H5 mais avec beaucoup plus de personnes que ce qui est indiqué dans l'exemple, plus de 300 personnes, donc le tableau à traiter de A1 à H300 environ
Je voudrais à partir de ce premier tableau en créer un second dans une nouvelle feuille (dans un autre fichier excel ou à minima un autre onglet) sous Ce tableau ainsi généré devrait avoir la forme du second tableau de mon exemple (situé en A9:H21 dans mon exemple)
Le tableau ainsi créé dans une nouvelle page aurait encore plus de lignes bien entendu, de l'ordre de 1000 lignes

Désolé de ne pas avoir été assez précis mais ce n'est jamais simple de bien expliciter le besoin

 

[julien6337]

ET lorsqu'une case est vide (par exemple Pierre Dupont n'a pas de mission le mardi en F2), je ne souhaite pas généré de ligne dans le nouveau tableau

 

[job75]

Oui c'est de ma faute je n'avais pas bien lu.

Alors voyez le fichier .xlsm joint et cette macro dans le code de la feuille "Résultat" (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Activate()
Dim tablo1, nlig&, tablo2, ncol%, j%, i&, n&
With Feuil1 'CodeName de la feuille source
    tablo1 = .[A1].CurrentRegion.Resize(, 3) 'matrice, plus rapide
    nlig = UBound(tablo1)
    If nlig = 1 Then GoTo 1 'si le tableau est vide
    tablo2 = .[E1].CurrentRegion.Resize(nlig) 'matrice, plus rapide
    ncol = UBound(tablo2, 2)
End With
'---tableau des résultats---
ReDim resu(1 To ncol * (nlig - 1), 1 To 5)
For j = 1 To ncol
    For i = 2 To nlig
        If tablo2(i, j) <> "" Then
            n = n + 1
            resu(n, 1) = tablo2(1, j)
            resu(n, 2) = tablo1(i, 1)
            resu(n, 3) = tablo1(i, 2)
            resu(n, 4) = tablo1(i, 3)
            resu(n, 5) = tablo2(i, j)
        End If
Next i, j
'---restitution---
1 If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] 'cellule de restitution, à adapter
    If n Then
        .Resize(n, 5) = resu
        .Resize(n, 5).Borders.Weight = xlThin 'bordures
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 5).Delete xlUp 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Elle se déclenche quand on active la feuille.

L'exécution est très rapide car on utilise des tableaux VBA.

A+

 

[julien6337]

Re Bonjour et merci beaucoup,
je suis toujours étonné des compétences existant dans ce domaine, et aspire un jour à pouvoir réussir seul ce type d'exercice

 

[julien6337]

Bonjour, merci le code dans mon second onglet qui fonctionne bien pour aller chercher les données comme je le voulais.
J'ai ensuite essayé d'aller chercher pour rappatrier dans mon second onglet une deuxième info dans une seconde matrice de mon premier onglet qui se situe un peu plus loin dans les colonnes de mon premier onglet. Je réussis bien à rapatrier les données mais je voudrais les inscrire dans la colonne qui suit celle ou je rapatrie ma première donnée or elles viennent se coller en dessous des premières en créant de nouvelles lignes,
je dois faire une erreur que je ne retrouve pas

Option Explicit

Private Sub Worksheet_Activate()
Dim tablo1, nlig&, tablo2, tablo3, tablo4, ncol%, ncol2%, j%, i&, n&
With Feuil1 'CodeName de la feuille source
tablo1 = .[A1].CurrentRegion.Resize(, 28) 'matrice, plus rapide
tablo4 = .[A1].CurrentRegion.Resize(, 28)
nlig = UBound(tablo1)
If nlig = 1 Then GoTo 1 'si le tableau est vide
tablo2 = .[AE1].CurrentRegion.Resize(nlig) 'matrice, plus rapide
tablo3 = .[EH1].CurrentRegion.Resize(nlig)
ncol = UBound(tablo2, 2)

End With
'---tableau des résultats---
ReDim resu(1 To ncol * (nlig - 1), 1 To 30)
For j = 1 To ncol
For i = 2 To nlig
If tablo2(i, j) <> "" Then
n = n + 1
resu(n, 1) = tablo2(1, j)
resu(n, 2) = tablo1(i, 1)
resu(n, 3) = tablo1(i, 2)
resu(n, 4) = tablo1(i, 3)
resu(n, 5) = tablo1(i, 4)
resu(n, 6) = tablo1(i, 5)
resu(n, 7) = tablo1(i, 6)
resu(n, 8) = tablo1(i, 7)
resu(n, 9) = tablo1(i, 8)
resu(n, 10) = tablo1(i, 9)
resu(n, 11) = tablo1(i, 10)
resu(n, 12) = tablo1(i, 11)
resu(n, 13) = tablo1(i, 12)
resu(n, 14) = tablo1(i, 13)
resu(n, 15) = tablo1(i, 14)
resu(n, 16) = tablo1(i, 15)
resu(n, 17) = tablo1(i, 16)
resu(n, 18) = tablo1(i, 17)
resu(n, 19) = tablo1(i, 18)
resu(n, 20) = tablo1(i, 19)
resu(n, 21) = tablo1(i, 20)
resu(n, 22) = tablo1(i, 21)
resu(n, 23) = tablo1(i, 22)
resu(n, 24) = tablo1(i, 23)
resu(n, 25) = tablo1(i, 24)
resu(n, 26) = tablo1(i, 25)
resu(n, 27) = tablo1(i, 26)
resu(n, 28) = tablo1(i, 27)
resu(n, 29) = tablo1(i, 28)
resu(n, 30) = tablo2(i, j)

End If
Next i, j

For j = 1 To ncol
For i = 2 To nlig
If tablo3(i, j) <> "" Then
n = n + 1
resu(n, 1) = tablo3(1, j)
resu(n, 2) = tablo4(i, 1)
resu(n, 3) = tablo4(i, 2)
resu(n, 4) = tablo4(i, 3)
resu(n, 5) = tablo4(i, 4)
resu(n, 6) = tablo4(i, 5)
resu(n, 7) = tablo4(i, 6)
resu(n, 8) = tablo4(i, 7)
resu(n, 9) = tablo4(i, 8)
resu(n, 10) = tablo4(i, 9)
resu(n, 11) = tablo4(i, 10)
resu(n, 12) = tablo4(i, 11)
resu(n, 13) = tablo4(i, 12)
resu(n, 14) = tablo4(i, 13)
resu(n, 15) = tablo4(i, 14)
resu(n, 16) = tablo4(i, 15)
resu(n, 17) = tablo4(i, 16)
resu(n, 18) = tablo4(i, 17)
resu(n, 19) = tablo4(i, 18)
resu(n, 20) = tablo4(i, 19)
resu(n, 21) = tablo4(i, 20)
resu(n, 22) = tablo4(i, 21)
resu(n, 23) = tablo4(i, 22)
resu(n, 24) = tablo4(i, 23)
resu(n, 25) = tablo4(i, 24)
resu(n, 26) = tablo4(i, 25)
resu(n, 27) = tablo4(i, 26)
resu(n, 28) = tablo4(i, 27)
resu(n, 29) = tablo4(i, 28)
resu(n, 30) = tablo3(i, j)

End If
Next i, j
'---restitution---
1 If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] 'cellule de restitution, à adapter
If n Then
.Resize(n, 30) = resu
.Resize(n, 30).Borders.Weight = xlThin 'bordures
End If
.Offset(n).Resize(Rows.Count - n - .Row + 1, 30).Delete xlUp 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

 

[julien6337]

Avec l'exemple,

dans le fichier joint en fiche résultat sont rapatriés les aides du tableau 2 de l'onglet Feuil 1 et je cherche à rapatrier dans une nouvelle colonne (F) de l'onglet résultat les éléments du tableau 3 de l'onglet feuil1, mais je n'y parviens pas

 

[job75]

Bonsoir julien6337,

L'adaptation pour la 6ème colonne est assez simple, voyez le fichier joint et la macro :

Private Sub Worksheet_Activate()
Dim tablo1, nlig&, tablo2, ncol%, tablo3, j%, i&, n&
With Feuil1
    tablo1 = .[A1].CurrentRegion.Resize(, 3)
    nlig = UBound(tablo1)
    If nlig = 1 Then GoTo 1
    tablo2 = .[E1].CurrentRegion.Resize(nlig)
    ncol = UBound(tablo2, 2)
    tablo3 = .[J1].CurrentRegion.Resize(nlig, ncol)
End With
'---tableau des résultats---
ReDim resu(1 To ncol * (nlig - 1), 1 To 6)
For j = 1 To ncol
    For i = 2 To nlig
        If tablo2(i, j) <> "" Then
            n = n + 1
            resu(n, 1) = tablo2(1, j)
            resu(n, 2) = tablo1(i, 1)
            resu(n, 3) = tablo1(i, 2)
            resu(n, 4) = tablo1(i, 3)
            resu(n, 5) = tablo2(i, j)
            resu(n, 6) = tablo3(i, j)
        End If
Next i, j
'---restitution---
1 If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] 'cellule de restitution, à adapter
    If n Then
        .Resize(n, 6) = resu
        .Resize(n, 6).Borders.Weight = xlThin 'bordures
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 6).Delete xlUp 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Cela dit il y a une contrainte : Tableaux 2 et Tableau 3 doivent se correspondre exactement, il y a risque d'erreurs.

Il vaudrait mieux fusionner ces 2 tableaux en mettant 2 données concaténées dans chaque cellule.

A+

 

[julien6337]

Merci Beaucoup,
je m'en veux de ne pas avoir trouvé seul car c'est vrai que ce n'est pas si compliqué, j'ai beaucoup de progrès à faire... c'est en cherchant qu'on doit progresser

 

[Amilo]

Bonjour à tous,
Une proposition avec Power query dans le tableau de droite de l'onglet "Resultat"
Cordialement