IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Transposition partielle de tableau [XL-2010]


Sujet :

Macros et VBA Excel

  1. #1
    Nouveau membre du Club
    Homme Profil pro
    contrôleur gestion
    Inscrit en
    Septembre 2014
    Messages
    53
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : contrôleur gestion

    Informations forums :
    Inscription : Septembre 2014
    Messages : 53
    Points : 26
    Points
    26
    Par défaut Transposition partielle de tableau
    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.

    Nom : ETAT RH 1ere version.png
Affichages : 285
Taille : 286,5 Ko

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

    Nom : Tableau après macro.png
Affichages : 242
Taille : 271,0 Ko

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

    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
    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 :

    Nom : ETAT RH  2eme version.png
Affichages : 224
Taille : 305,7 Ko

    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))

    Nom : Tableau après macro (2eme version).png
Affichages : 245
Taille : 263,2 Ko


    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

  2. #2
    Nouveau membre du Club
    Homme Profil pro
    contrôleur gestion
    Inscrit en
    Septembre 2014
    Messages
    53
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : contrôleur gestion

    Informations forums :
    Inscription : Septembre 2014
    Messages : 53
    Points : 26
    Points
    26
    Par défaut
    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

  3. #3
    Expert confirmé
    Homme Profil pro
    Responsable des études
    Inscrit en
    Juillet 2014
    Messages
    2 651
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Aude (Languedoc Roussillon)

    Informations professionnelles :
    Activité : Responsable des études
    Secteur : Santé

    Informations forums :
    Inscription : Juillet 2014
    Messages : 2 651
    Points : 5 769
    Points
    5 769
    Par défaut
    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.
    J'aimerais bien aller vivre en Théorie, car en Théorie tout se passe bien.

  4. #4
    Nouveau membre du Club
    Homme Profil pro
    contrôleur gestion
    Inscrit en
    Septembre 2014
    Messages
    53
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : contrôleur gestion

    Informations forums :
    Inscription : Septembre 2014
    Messages : 53
    Points : 26
    Points
    26
    Par défaut
    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.

    RHPNM V2.xlsx


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

    M75

  5. #5
    Membre habitué Avatar de Klin89
    Profil pro
    Inscrit en
    Octobre 2008
    Messages
    119
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Octobre 2008
    Messages : 119
    Points : 178
    Points
    178
    Par défaut
    Bonsoir morgan75, halaster08

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

    Remplace :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    ReDim b(1 To (((UBound(a, 2) - 5) / 2) * (UBound(a, 1) - 1)), 1 To 8)
    par
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    ReDim b(1 To (((UBound(a, 2) - 9) / 3) * (UBound(a, 1) - 1)), 1 To 13)
    puis :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    For j = 6 To UBound(a, 2) Step 2
    par
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    For j = 10 To UBound(a, 2) Step 3
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    With Sheets("RHPNM RESULTAT").Cells(1).Resize(, 8)
    par
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    With Sheets("RHPNM RESULTAT").Cells(1).Resize(, 13)
    et rajoute ceci :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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

  6. #6
    Nouveau membre du Club
    Homme Profil pro
    contrôleur gestion
    Inscrit en
    Septembre 2014
    Messages
    53
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : contrôleur gestion

    Informations forums :
    Inscription : Septembre 2014
    Messages : 53
    Points : 26
    Points
    26
    Par défaut
    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 : 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
    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

    RHPNM V3.xlsx


    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    ReDim b(1 To (((UBound(a, 2) - 6) / 2) * (UBound(a, 1) - 1)), 1 To 9)
    et:

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    For j = 10 To UBound(a, 2) Step 3
    Je te remercie pour ton aide précieuse

    Morgan75

  7. #7
    Membre habitué Avatar de Klin89
    Profil pro
    Inscrit en
    Octobre 2008
    Messages
    119
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Octobre 2008
    Messages : 119
    Points : 178
    Points
    178
    Par défaut
    re morgan75,

    un poil réajusté :
    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
    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

  8. #8
    Nouveau membre du Club
    Homme Profil pro
    contrôleur gestion
    Inscrit en
    Septembre 2014
    Messages
    53
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Seine et Marne (Île de France)

    Informations professionnelles :
    Activité : contrôleur gestion

    Informations forums :
    Inscription : Septembre 2014
    Messages : 53
    Points : 26
    Points
    26
    Par défaut
    Bonjour Klin 89,

    La macro fonctionne parfaitement,
    merci beaucoup

    Morgan 75

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2010] Transposition partielle d'un tableau
    Par morgan75 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 09/08/2017, 16h06
  2. [XL-2010] Transposition partielle d'un tableau
    Par morgan75 dans le forum Excel
    Réponses: 4
    Dernier message: 02/09/2016, 16h13
  3. Transposition d'un tableau
    Par mouaa dans le forum Excel
    Réponses: 2
    Dernier message: 20/07/2008, 11h57
  4. [VBA Access] programmer la transposition d'un tableau
    Par xxlunexx dans le forum VBA Access
    Réponses: 3
    Dernier message: 02/07/2007, 12h28
  5. transposition d'un tableau de colonnes en lignes
    Par Prissou dans le forum VBA Word
    Réponses: 5
    Dernier message: 16/06/2007, 20h29

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo