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 :

INVERSER les colonnes avec les lignes macro VBA


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre averti
    Femme Profil pro
    Responsable projets transverses
    Inscrit en
    Mars 2016
    Messages
    12
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Val de Marne (Île de France)

    Informations professionnelles :
    Activité : Responsable projets transverses
    Secteur : Finance

    Informations forums :
    Inscription : Mars 2016
    Messages : 12
    Par défaut INVERSER les colonnes avec les lignes macro VBA
    Bonjour,

    J'ai un fichier avec pleins de macro VBA pour une priorisation de projets. Suite à une réunion on m'a demandé d'inverser les colonnes avec les lignes de mon tableau EVALUATION.
    Nom : Capture.PNG
Affichages : 200
Taille : 32,5 Ko

    Y'a-t-il une façon de le faire par macro afin de ne pas retaper tout le code ?

    NB : le tableau a des listes déroulantes et des calculs par macro

    Je vous joins les codes correspondant à la feuille EVALUATION :

    Option Explicit
    Option Private Module

    Sub MaJ()

    With Sheet4 'paramétrage critères de sélection
    Dim Col_Od As Integer: Col_Od = .Range("C6").Value 'Ordre
    Dim Col_Nm As Integer: Col_Nm = .Range("C7").Value 'Noms des criteres
    Dim Col_P1 As Integer: Col_P1 = .Range("C8").Value 'Premiere Colonne des points
    Dim Col_Pn As Integer: Col_Pn = .Range("C9").Value 'Derniere Colonne des points
    Dim Col_Cf As Integer: Col_Cf = .Range("C10").Value 'Coefficients
    Dim Lig_Pr As Integer: Lig_Pr = .Range("C17").Value 'Premiere ligne apres en-tete
    End With

    With Sheet4 'paramétrage évaluation
    Dim Col2_Pr As Integer: Col2_Pr = .Range("F5").Value 'Premiere
    Dim Col2_Od As Integer: Col2_Od = .Range("F6").Value 'Ordre
    Dim Col2_Nm As Integer: Col2_Nm = .Range("F7").Value 'Noms des criteres
    Dim Col2_Cf As Integer: Col2_Cf = .Range("F8").Value 'Coefficients
    Dim Col2_P1 As Integer: Col2_P1 = .Range("F9").Value 'Premiere Colonne des projets
    Dim Col2_Dr As Integer: Col2_Dr = .Range("F10").Value 'Derniere
    Dim Lig2_Pr As Integer: Lig2_Pr = .Range("F17").Value 'Premiere ligne apres en-tete
    Dim Nbr2_Pr As Integer: Nbr2_Pr = .Range("L2").Value 'Nombre des projets
    End With

    Dim I, J, Max As Integer
    Dim Nom As String
    Dim Nm As Name
    Dim RngName As String

    RngName = "Priorite"

    Alerts False

    With Sheet3 'évaluation
    .Shapes("Rectangle").Top = 0
    .Shapes("Rectangle").Left = 0

    Max = .Cells(Lig2_Pr - 1, Columns.Count).End(xlToLeft).Column
    'If Max >= Col2_P1 Then .Range(.Cells(Lig2_Pr, Col2_P1), .Cells(Lig2_Pr, Max)).Delete shift:=xlToLeft

    ' Criteres de sélection
    Max = Sheet2.Cells(Rows.Count, Col_Od).End(xlUp).Row

    If Max >= Lig_Pr Then
    Sheet2.Range(Sheet2.Cells(Lig_Pr, Col_Od), Sheet2.Cells(Max, Col_Od)).Copy
    .Cells(Lig2_Pr, Col2_Od).PasteSpecial xlPasteValues
    .Cells(Lig2_Pr, Col2_Od).PasteSpecial xlPasteValidation

    Sheet2.Range(Sheet2.Cells(Lig_Pr, Col_Nm), Sheet2.Cells(Max, Col_Nm)).Copy
    .Cells(Lig2_Pr, Col2_Nm).PasteSpecial xlPasteValues
    .Cells(Lig2_Pr, Col2_Nm).PasteSpecial xlPasteValidation

    Sheet2.Range(Sheet2.Cells(Lig_Pr, Col_Cf), Sheet2.Cells(Max, Col_Cf)).Copy
    .Cells(Lig2_Pr, Col2_Cf).PasteSpecial xlPasteValues
    .Cells(Lig2_Pr, Col2_Cf).PasteSpecial xlPasteValidation
    End If

    ' Projets
    J = 1
    If Nbr2_Pr > 0 Then
    For I = Col2_P1 To Col2_P1 + Nbr2_Pr - 1
    If .Cells(Lig2_Pr - 1, I).Value = "" Then .Cells(Lig2_Pr - 1, I).Value = "Projet " & J
    .Cells(Lig2_Pr - 1, I).WrapText = True
    .Cells(Lig2_Pr - 1, I).Orientation = 45
    J = J + 1
    Next I
    End If

    ' Matrice Validation Data
    J = Lig2_Pr
    If Nbr2_Pr > 0 And Col_Pn - Col_P1 > 0 Then

    For Each Nm In ActiveWorkbook.Names
    On Error Resume Next
    If Nm.Name <> "Coefficients" And Nm.Name <> "Priorite" Then Nm.Delete
    Next Nm

    For I = Lig_Pr To Max
    Nom = "Noms" & I
    Sheet2.Range(Sheet2.Cells(I, Col_P1), Sheet2.Cells(I, Col_Pn)).Name = Nom
    Nom = "=" & Nom
    .Range(.Cells(J, Col2_P1), .Cells(J, Col2_P1 + Nbr2_Pr - 1)).Validation.Delete
    .Range(.Cells(J, Col2_P1), .Cells(J, Col2_P1 + Nbr2_Pr - 1)).Validation.Add _
    Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
    Formula1:=Nom
    J = J + 1
    Next I
    End If


    Sub MaJTotal()

    With Sheet4 'paramétrage critères de sélection
    Dim Col_Od As Integer: Col_Od = .Range("C6").Value 'Ordre
    Dim Col_Nm As Integer: Col_Nm = .Range("C7").Value 'Noms des criteres
    Dim Col_P1 As Integer: Col_P1 = .Range("C8").Value 'Premiere Colonne des points
    Dim Col_Pn As Integer: Col_Pn = .Range("C9").Value 'Derniere Colonne des points
    Dim Col_Cf As Integer: Col_Cf = .Range("C10").Value 'Coefficients
    Dim Lig_Pr As Integer: Lig_Pr = .Range("C17").Value 'Premiere ligne apres en-tete
    End With

    With Sheet4 'paramétrage évaluation
    Dim Col2_Pr As Integer: Col2_Pr = .Range("F5").Value 'Premiere
    Dim Col2_Od As Integer: Col2_Od = .Range("F6").Value 'Ordre
    Dim Col2_Nm As Integer: Col2_Nm = .Range("F7").Value 'Noms des criteres
    Dim Col2_Cf As Integer: Col2_Cf = .Range("F8").Value 'Coefficients
    Dim Col2_P1 As Integer: Col2_P1 = .Range("F9").Value 'Premiere Colonne des projets
    Dim Col2_Dr As Integer: Col2_Dr = .Range("F10").Value 'Derniere
    Dim Lig2_Pr As Integer: Lig2_Pr = .Range("F17").Value 'Premiere ligne apres en-tete
    Dim Nbr2_Pr As Integer: Nbr2_Pr = .Range("L2").Value 'Nombre des projets
    End With

    Dim I, J, Max As Integer
    Dim RngName As String
    Max = Sheet2.Cells(Rows.Count, Col_Od).End(xlUp).Row

    RngName = "Priorite"

    Alerts False

    With Sheet3 'évaluation
    For I = Col2_P1 To Col2_P1 + Nbr2_Pr - 1
    .Cells(Lig2_Pr + Max - Lig_Pr + 1, I).Value = TotalPoints(Col2_Cf, .Range(.Cells(Lig2_Pr, I), .Cells(Lig2_Pr + Max - Lig_Pr, I)), Col_P1, Col_Pn)

    If .Cells(Lig2_Pr + Max - Lig_Pr + 1, I).Value <> "" Then
    For J = 0 To Sheet4.Range(RngName).Count - 1
    If CInt(.Cells(Lig2_Pr + Max - Lig_Pr + 1, I).Value) >= CInt(Sheet4.Cells(Sheet4.Range(RngName).Row + J, Sheet4.Range(RngName).Column - 1).Value) And _
    CInt(.Cells(Lig2_Pr + Max - Lig_Pr + 1, I).Value) <= CInt(Sheet4.Cells(Sheet4.Range(RngName).Row + J, Sheet4.Range(RngName).Column + 1).Value) Then

    .Cells(Lig2_Pr + Max - Lig_Pr + 1, I).Interior.Color = Sheet4.Cells(Sheet4.Range(RngName).Row + J, Sheet4.Range(RngName).Column).Interior.Color
    .Cells(Lig2_Pr + Max - Lig_Pr + 2, I).Interior.Color = Sheet4.Cells(Sheet4.Range(RngName).Row + J, Sheet4.Range(RngName).Column).Interior.Color
    .Cells(Lig2_Pr + Max - Lig_Pr + 2, I).Value = Sheet4.Cells(Sheet4.Range(RngName).Row + J, Sheet4.Range(RngName).Column).Value
    Exit For
    End If
    Next J
    End If
    Next I
    End With

    Alerts True
    End Sub

  2. #2
    Membre Expert
    Profil pro
    Inscrit en
    Septembre 2010
    Messages
    1 545
    Détails du profil
    Informations personnelles :
    Âge : 46
    Localisation : France

    Informations forums :
    Inscription : Septembre 2010
    Messages : 1 545
    Par défaut
    On appelle ça, transposer un tableau. ça peut se faire via une opération de copier/collage spécial (faisable aussi en VBA)
    https://learn.microsoft.com/fr-fr/of...e.pastespecial

    Sinon toutes tes variables col_... vont indiquer maintenant des lignes, donc inverser l'ordre ligne, colonne dans les appels .Cells(ligne,colonne)

  3. #3
    Membre averti
    Femme Profil pro
    Responsable projets transverses
    Inscrit en
    Mars 2016
    Messages
    12
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France, Val de Marne (Île de France)

    Informations professionnelles :
    Activité : Responsable projets transverses
    Secteur : Finance

    Informations forums :
    Inscription : Mars 2016
    Messages : 12
    Par défaut
    Citation Envoyé par umfred Voir le message
    On appelle ça, transposer un tableau. ça peut se faire via une opération de copier/collage spécial (faisable aussi en VBA)
    https://learn.microsoft.com/fr-fr/of...e.pastespecial

    Sinon toutes tes variables col_... vont indiquer maintenant des lignes, donc inverser l'ordre ligne, colonne dans les appels .Cells(ligne,colonne)
    je n'ai pas réussi la transposition ça ne fonctionne pas correctement ...

    est-ce que l'inversion ligne/colonne dans les appels suffit à inverser le tableau ? (pas besoin de modifier mes variables ?)

  4. #4
    Rédacteur
    Avatar de Philippe Tulliez
    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    Janvier 2010
    Messages
    13 171
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : Janvier 2010
    Messages : 13 171
    Billets dans le blog
    53
    Par défaut
    Bonjour,
    je n'ai pas réussi la transposition ça ne fonctionne pas correctement ...
    est-ce que l'inversion ligne/colonne dans les appels suffit à inverser le tableau ? (pas besoin de modifier mes variables ?)
    Voici un exemple illustré de la transposition d'une plage A2:F9 de la feuille nommée DashBoard que l'on transpose à partir de la cellule A14 de la même feuille

    Manuellement
    1. Sélection de la plage A2:F9
    2. Copier
    3. Sélectionner la cellule A14
    4. Clic droit et dans le menu contextuel aller dans le Collage Special et sélectionner le bouton Transpose


    Avec une procédure VBA
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    Sub t()
      With ThisWorkbook.Worksheets("DashBoard")
      .Range("A2").CurrentRegion.Copy
      .Range("A14").PasteSpecial Paste:=xlPasteAll, Transpose:=True
      End With
      Application.CutCopyMode = False
    End Sub
    Nom : 230825 dvp Transpose.png
Affichages : 138
Taille : 50,9 Ko
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Mon dernier billet : Utilisation de la fonction Dir en VBA pour vérifier l'existence d'un fichier

  5. #5
    Membre émérite Avatar de Alex020181
    Homme Profil pro
    Prestataire informatique développeur d'application Excel, Access, VBA
    Inscrit en
    Juin 2012
    Messages
    601
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 44
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Prestataire informatique développeur d'application Excel, Access, VBA

    Informations forums :
    Inscription : Juin 2012
    Messages : 601
    Par défaut
    Bonjour,

    Que ce soit par code ou par copier / coller transposer il est tout à fait possible de faire cette transposition. D'ailleurs de ce que je comprends cette opération est à faire une seule fois tu iras donc bien plus vite en la faisant en copiant / transposant qu'avec du code.

    Par contre tu dis que ton fichier contient déjà d'autres macros. Il faut t'assurer de modifier également ces macros si besoin pour les adapter à ce nouveau format.

    Avec le code que je vois rapidement ici la réponse à ta question est "non il ne te suffira pas d'inverser ligne et colonne dans ton code". Tu vas devoir reprendre le code.

    Si tu ne t'en sens pas capable tu as une autre solution (mais ce serait une grosse rustine pas glop). Tu peux créer une nouvelle feuille avec ton tableau transposé et créer du code que tu lanceras sur demande pour aller récupérer les données dans ta feuille initiale et les reporter dans ta nouvelle feuille nouveau format. Comme j'ai dis c'est une solution grossière et uniquement visuelle. Le mieux reste de faire ta transposition par copier / coller transposer, retravailler la mise en forme qui aura certainement sauté et reprendre le code existant pour l'adapter.

Discussions similaires

  1. [CR 2008] Inverser les lignes et les colonnes
    Par ouistitis dans le forum SAP Crystal Reports
    Réponses: 2
    Dernier message: 27/09/2015, 21h43
  2. Inverses les lignes impaires d'un tableau de points
    Par AliFirat91 dans le forum Collection et Stream
    Réponses: 2
    Dernier message: 16/12/2011, 13h52
  3. inverser les lignes en colonnes d'un TDBGrid
    Par znathan dans le forum Composants VCL
    Réponses: 6
    Dernier message: 29/08/2011, 11h52
  4. Java - inverser les lignes d'un fichier volumineux
    Par Redouane81 dans le forum Général Java
    Réponses: 6
    Dernier message: 18/08/2011, 16h43
  5. Réponses: 2
    Dernier message: 19/04/2007, 11h23

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