Transposition partielle de tableau

Version imprimable

4 pièce(s) jointe(s)

Bonsoir,

Par le passé, j'avais eu besoin de réaliser une transposition partielle d'un état RH . Un membre de ce site m'avait proposé une macro qui marchait très bien avec une variable tableau dynamique et une boucle.
Malheureusement, l'état RH a été enrichi et je dois faire apparaître une nouvelle donnée dans le tableau final (post macro). Ma connaissance des variables tableau dynamique étant ce qu'elle est , je n'arrive pas à adapter le script qui m'a été donné à ce nouvel état RH.

Pour avoir une petite idée de la configuration de l'état RH d'origine je vous fais suivre une image. Je précise que les données que je vous transmets sont anonymisés.

Pièce jointe 427279

A partir de cet état la macro réalisait cela:

Pièce jointe 427281

Tout cela était réalisé grace à cette macro:
Code:

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 Sub TRANSPOSE_RHPNM() Dim a, b(), i As Long, j As Long, n As Long, x With Sheets("RHPNM 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), "-") 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) = x(0): b(n, 7) = a(i, j) b(n, 8) = a(i, j + 1) Next Next With Sheets("RHPNM RESULTAT").Cells(1).Resize(, 8) .CurrentRegion.Clear .Value = [{"Unité","Code type Statut","Libellé type 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
Mon problème est que mon état RH a évolué et intègre la donnée ETP tra (3)

Voila le nouvel état RH :

Pièce jointe 427287

Il faudrait que le tableau après que la macro ai tourné ressemble a cela ( la dernière colonne doit contenir l'information relative à ETP tra (3))

Pièce jointe 427288

J'ai conscience qu'il faut toucher aux dimensions avec la fonction Redim et modifier les valeurs dans le tableau, mais mes tentatives se soldent par un échec.
Quelqu'un serait en mesure de m'aider .

En vous remerciant

Morgan

21/11/2018, 10h08
morgan75

Bonjour,

Le script VBA est par trop compliqué à modifié , qu'aucune réponse n'a été apporté à ma question ?
Cette modification de ce script VBA m'aurait en outre aidé par comparaison à comprendre un peu mieux les macro de variables tableaux dynamiques.
En vous remerciant
21/11/2018, 10h58
halaster08

Bonjour,

As-tu essayé de contacter la personne qui t'as fait cette macro ?
Ce n'est pas toujours facile de reprendre le travail d'un autre, l'auteur de cette macro arrivera certainement plus facilement a faire les modifications

Peux-tu nous donner le lien vers la discussion où on t'avais donner cette macro ? Il y a peut être des infos dans l'échange qui pourraient aidé à comprendre plus facilement cette macro.
Peux-tu également joindre un fichier exemple de quelques ligne anonymisées (et sans la macro) afin de faire des tests.
21/11/2018, 11h51
morgan75

1 pièce(s) jointe(s)

Bonjour,

Celui qui m'a procuré la macro s'appelle Klin 89
le chemin de la discussion est : https://www.developpez.net/forums/d1...lle-d-tableau/

le fichier originel (sans macro) est envoyé en pièce jointe. Le 1er onglet "RHPNM SOURCE" contient la base de données à modifier, le second onglet "RHPNM RESULTAT" contient le tableau après intervention de la macro.

Pièce jointe 428604

Je te remercie Halaster 08 de te pencher sur mon problème.

M75

Bonsoir morgan75, halaster08 :)

J'y vais à l'aveuglette vu que tes images sont invoyables :mouarf:

Remplace :

Code:

ReDim b(1 To (((UBound(a, 2) - 5) / 2) * (UBound(a, 1) - 1)), 1 To 8)

par

Code:

ReDim b(1 To (((UBound(a, 2) - 9) / 3) * (UBound(a, 1) - 1)), 1 To 13)

puis :

Code:

For j = 6 To UBound(a, 2) Step 2

par

Code:

For j = 10 To UBound(a, 2) Step 3

Code:

With Sheets("RHPNM RESULTAT").Cells(1).Resize(, 8)

par

Code:

With Sheets("RHPNM RESULTAT").Cells(1).Resize(, 13)

et rajoute ceci :
Code:

1 2 3 4 5 6 7 8 9 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, 6) = a(i, 6) b(n, 7) = a(i, 7): b(n, 8) = a(i, 8) b(n, 9) = a(i, 9): b(n, 10) = x(0) b(n, 11) = a(i, j) b(n, 12) = a(i, j + 1) b(n, 13) = a(i, j + 2)
Pour le reste, je te laisse peaufiner les derniers réglages.

klin89

1 pièce(s) jointe(s)

Bonjour Klin 89,

Ta macro a généré un tableau de 13 colonnes, alors que j'avais besoin d'une colonne supplementaire (ETP tra) par rapport au tableau d'origine (8 colonnes). En outre, les données que la macro remontait, n'étaient pas issues des bonnes colonnes de l'état RH source ou étaient enregistrées dans les mauvaises colonnes du tableau post macro. J'ai donc modifié la macro et le tableau semble convenir .....il n'y a pas de risque d'un melange du contenu des colonnes apres l'intervention de la macro ? :
Code:

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 Sub TRANSPOSE_RHPNM1() Dim a, b(), i As Long, j As Long, n As Long, x With Sheets("RHPNM SOURCE").Range("a4").CurrentRegion a = .Value End With ReDim b(1 To (((UBound(a, 2) - 6) / 2) * (UBound(a, 1) - 1)), 1 To 9) For i = 2 To UBound(a, 1) For j = 10 To UBound(a, 2) Step 3 n = n + 1 x = Split(a(1, j), "-") b(n, 1) = a(i, 4): b(n, 2) = a(i, 6): b(n, 3) = a(i, 7) b(n, 4) = a(i, 8): b(n, 5) = a(i, 9) b(n, 6) = x(0): b(n, 7) = a(i, j) b(n, 8) = a(i, j + 1) b(n, 9) = a(i, j + 2) Next Next With Sheets("RHPNM RESULTAT").Cells(1).Resize(, 9) .CurrentRegion.Clear .Value = [{"Unité","Code type Statut","Libellé type statut","Code emploi","Libellé emploi","Mois","Eff Prév","Etp Rém","ETP Tra"}] .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
Je t'envoie le fichier Excel sans macro

1er onglet RHPNM SOURCE: etat RH
2eme onglet RHPNM RESULTAT: tableau obtebu apres usage de la macro ci dessus

Pièce jointe 430236

Par contre, je ne suis pas sur des modifications que j'ai apporté aux 2 lignes suivantes que j'ai modifiées completement à l'aveugle:

Code:

ReDim b(1 To (((UBound(a, 2) - 6) / 2) * (UBound(a, 1) - 1)), 1 To 9)

et:

Code:

For j = 10 To UBound(a, 2) Step 3

Je te remercie pour ton aide précieuse

Morgan75

re morgan75,:)

un poil réajusté :

Code:

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
Option Explicit
Sub TRANSPOSE_RHPNM1()
Dim a, b(), i As Long, j As Long, n As Long, x
    Application.ScreenUpdating = False
    a = Sheets("RHPNM SOURCE").Range("a1").CurrentRegion.Value
    ReDim b(1 To (((UBound(a, 2) - 9) / 3) * (UBound(a, 1) - 1)), 1 To 9)
    For i = 2 To UBound(a, 1)
        For j = 10 To UBound(a, 2) Step 3
            n = n + 1
            x = Split(a(1, j), "-")
            b(n, 1) = a(i, 4): b(n, 2) = a(i, 6): b(n, 3) = a(i, 7)
            b(n, 4) = a(i, 8): b(n, 5) = a(i, 9): b(n, 6) = x(0)
            b(n, 7) = a(i, j): b(n, 8) = a(i, j + 1): b(n, 9) = a(i, j + 2)
        Next
    Next
    With Sheets("RHPNM RESULTAT").Cells(1)
        .CurrentRegion.Clear
        With .Resize(, 9)
            .Value = [{"Unité","Code type Statut","Libellé type statut","Code emploi","Libellé emploi","Mois","Eff Prév","Etp Rém","ETP Tra"}]
            .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 With
    Application.ScreenUpdating = True
End Sub

klin89

29/11/2018, 16h40
morgan75

Bonjour Klin 89,

La macro fonctionne parfaitement,
merci beaucoup

Morgan 75