Discussion :

[morgan75]

Bonjour,

Je dispose d'une macro obtenue sur le forum (si ma mémoire est bonne) qui me permet à partir d'un tableau ou les données sont ordonnées en colonnes mais également en lignes d'organiser un second tableau ou toutes les données sont en lignes. Seuls les mois, les EFF mensuels et les ETP mensuels sont transposés

Tableau initital 1

Unité ; Code statut ; libellé statut ; janvier eff; janvier ETP, février eff ; février ETP ...........; décembre eff ; décembre ETP

Tableau final 1

Unité ; Code statut ; libellé statut ; mois ; EFF ; ETP

Cette macro est une véritable bénédiction quand on sait le nombre de lignes qu'une base ressource humaine peut contenir mais elle ne m'a pas été expliquée et le problème c'est que le tableau initial a gagné 2 colonnes supplémentaires. là encore seuls les mois, les EFF mensuels et les ETP mensuels sont à transposer

Tableau initial 2

Unité ; Code statut ; libellé statut ; code emploi ; libellé emploi ; janvier eff; janvier ETP, février eff ; février ETP ...........; décembre eff ; décembre ETP

Le tableau final devrait prendre la forme suivante

Tableau final 2

Unité ; Code statut ; libellé statut ; code emploi ;libellé emploi ;mois ; EFF ; ETP



J'ai pris l'habitude d'utiliser le bouton F8 (pas à pas détaillé) pour tenter de comprendre le fonctionnement de la macro mais il semblerait que cette macro réalise tout d'abord la réorganisation complète du tableau avant de l'afficher sur le second onglet.


Je vous joins le code utilisé pour le tableau 1:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub TRANSPOSE_RHPM()
Dim a, b(), i As Long, j As Long, n As Long, x
    With Sheets("RHPM SOURCE").Range("a4").CurrentRegion
        a = .Value
    End With
    ReDim b(1 To (((UBound(a, 2) - 3) / 2) * (UBound(a, 1) - 1)), 1 To 6)
    For i = 2 To UBound(a, 1)
        For j = 4 To UBound(a, 2) Step 2
            n = n + 1
            x = Split(a(1, j), "-")
 
            b(n, 1) = a(i, 1): b(n, 2) = a(i, 2): b(n, 3) = a(i, 3)
            b(n, 4) = x(0): b(n, 5) = a(i, j)
            b(n, 5) = a(i, j): b(n, 6) = a(i, j + 1)
        Next
    Next
    With Sheets("RHPM RESULTAT").Cells(1).Resize(, 6)
        .CurrentRegion.Clear
        .Value = [{"Unité","Code Statut","Libellé Statut","Mois","Eff Prév","Etp Rém"}]
        .Offset(1).Resize(n).Value = b
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .BorderAround Weight:=xlThin
                .HorizontalAlignment = xlCenter
                .Interior.ColorIndex = 36
                .Font.Size = 11
            End With
            .Columns.ColumnWidth = 14
        End With
        .Parent.Activate
    End With
End Sub

Serait- il aussi possible d'avoir des explications pour ce script. Histoire de ne pas vous solliciter si d'aventure de nouvelles colonnes venaient à apparaître dans le fichier initial.

Merci beaucoup

[Klin89]

Bonsoir morgan75

Essaie ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Option Explicit
Sub transpose()
Dim a, b(), i As Long, j As Long, n As Long, x
    With Sheets("RHPM SOURCE").Range("a4").CurrentRegion
        a = .Value
    End With
    ReDim b(1 To (((UBound(a, 2) - 5) / 2) * (UBound(a, 1) - 1)), 1 To 8)
    For i = 2 To UBound(a, 1)
        For j = 6 To UBound(a, 2) Step 2
            n = n + 1
            x = Split(a(1, j), "-")
            If LCase(x(0)) = "fevrier" Then x(0) = "février"
            b(n, 1) = a(i, 1): b(n, 2) = a(i, 2): b(n, 3) = a(i, 3)
            b(n, 4) = a(i, 4): b(n, 5) = a(i, 5)
            'b(n, 3) = x(0): b(n, 4) = a(i, j)
            'ici le réajustement
            b(n, 6) = Month(CDate("01/" & "" & x(0) & "")): b(n, 7) = a(i, j)
            b(n, 8) = a(i, j + 1)
        Next
    Next
    With Sheets("RHPM RESULTAT").Cells(1).Resize(, 8)
        .CurrentRegion.Clear
        .Value = [{"Unité","Code Statut","Libellé statut","Code emploi","Libellé emploi","Mois","Eff Prév","Etp Rém"}]
        .Offset(1).Resize(n).Value = b
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .BorderAround Weight:=xlThin
                .HorizontalAlignment = xlCenter
                .Interior.ColorIndex = 36
                .Font.Size = 11
            End With
            .Columns.ColumnWidth = 14
        End With
        .Parent.Activate
    End With
End Sub

klin89

[morgan75]

Bonjour Klin89,

je te remercie pour les modifications apportées à la macro initiale. Elle fonctionne après avoir résolu un bug sur cette ligne de code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

b(n, 6) = Month(CDate("01/" & "" & x(0) & "")): b(n, 7) = a(i, j)

que j'ai remplacé par:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

b(n, 6) = x(0): b(n, 7) = a(i, j)

J'ai également retiré:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If LCase(x(0)) = "fevrier" Then x(0) = "février"

Ma procédure suivante ne reconnaissant pas février avec un accent.

Encore merci pour ton aide,

M75