INVERSER les colonnes avec les lignes macro VBA

1 pièce(s) jointe(s)

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.
Pièce jointe 640108

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

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)

Citation:

Envoyé par umfred

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

1 pièce(s) jointe(s)

Bonjour,

Citation:

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

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

Avec une procédure VBA
Code:

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
Pièce jointe 643083

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.