transposition matrice

[quezaco]

Bonjour au forum,

Etant nouvel arrivant, je me permet de faire appel à vos lumieres.

J'ai un tableau excel carré avec en partie gauche des données et je souhaite les transposer par le biais d'une macro qui maintiendrait le lien avec les données d'origine.
Ci-joint mon petit tableau (qui va s'étendre) avec la macro en question qui peut être simplifiée?
Merci de vos réponses

 

[jeanpierre]

Re : transposition matrice

Bonjour quezaco,

Deux solutions :

Ou ta question est très spécifique à Excel 2007, donc tu la poses dans le forum dédié avec ton fichier .xlsm

ou elle est plus générique et tu la poses ici avec un fichier sous format 97-2003 (par enregistré sous).

A te lire.

Jean-Pierre

 

[Guest]

Re : transposition matrice

Re Quezaco,
hello JP,

J'ai déjà fait galéré Quezaco parcequ'il avait posté son message dans un autre fil qui n'avait rien à voir. Alors pour l'aider un peu, je publie son fichier en xls ici.

A+

 

[quezaco]

Re : transposition matrice

Bonjour jeanpierre,
Effectivement vous avez raison de faire remarquer la chose car je travaille sous excel 2007 et je vais de ce pas changer de rubrique.
Merci de votre réponse.

 

[quezaco]

Re : transposition matrice

Re bonjour hasco,
Merci de vous occuper de mon petit problème.

 

[ROGER2327]

Re : transposition matrice

Bonsoir à tous

Une proposition de procédure évènementielle à placer dans le module de la feuille concernée :

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Change(ByVal Target As Range)
Dim oPlg As Range, oCel As Range
   Set oPlg = Range("C3").Resize(10, 10) [COLOR="SeaGreen"]'Range("coin_supérieur_gauche").Resize(nb_de_lignes,nb_de_colonnes)[/COLOR]
   If Not Intersect(Target, oPlg) Is Nothing Then
      Application.EnableEvents = False
      For Each oCel In Intersect(Target, oPlg)
         With Range(oPlg.Cells(1, 1), oCel)
            If .Rows.Count > .Columns.Count Then
               oPlg.Cells(1, 1).Offset(.Columns.Count - 1, .Rows.Count - 1).Value = oCel.Value
            End If
         End With
      Next
      Application.EnableEvents = True
   End If
End Sub[/B][/COLOR]

Toute modification dans la partie inférieure gauche sera répercutée dans la partie supérieure droite.

La plage concernée est quelconque, définie par la ligne :

[COLOR="DarkSlateGray"][B]   Set oPlg = Range("C3").Resize(10, 10) [/B][/COLOR]

(Dans cet exemple, la plage C3:L12.)​

ROGER2327
#3839

Mercredi 18 Gidouille 137 (Visitation de Mère Ubu, SS)
14 Messidor An CCXVIII
2010-W26-5T20:40:46Z

 

[pierrejean]

Re : transposition matrice

Bonjour quezaco
Salut Jeanpierre
Salut Hasco
Salut ROGER

Une petite adaptation de l'excellent code de ROGER pour ne pas avoir a intervenir sur le dit code en cas de changement des dimensions du tableau d'origine

Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR=blue]Dim oDerlin As Integer
[/COLOR][COLOR=blue]oDerlin = Range("C65536").End(xlUp).Row - 2
[/COLOR]Dim oPlg As Range, oCel As Range
   Set oPlg = Range("C3").Resize([COLOR=blue]oDerlin, oDerlin[/COLOR]) 'Range("coin_supérieur_gauche").Resize(nb_de_lignes,nb_de_colonnes)
   If Not Intersect(Target, oPlg) Is Nothing Then
      Application.EnableEvents = False
      For Each oCel In Intersect(Target, oPlg)
         With Range(oPlg.Cells(1, 1), oCel)
            If .Rows.Count > .Columns.Count Then
               oPlg.Cells(1, 1).Offset(.Columns.Count - 1, .Rows.Count - 1).Value = oCel.Value
            End If
         End With
      Next
      Application.EnableEvents = True
   End If
End Sub

 

[ROGER2327]

Re : transposition matrice

Bonjour pierrejean, bonjour à tous

L'idée de rendre la procédure dynamique est séduisante. Mais c'est plus complexe à faire qu'il n'y parait. Ainsi, avec la proposition que vous faites, si vous supprimez (effacez) une donnée de la dernière ligne de données de la colonne C, son homologue transposé n'est pas supprimé.
D'autre part, si on augmente le nombre de lignes de données, on peut être limité par le nombre de colonnes.
Il faut donc prendre quelques précautions. Sans être certain d'avoir considéré l'ensemble des cas de figure, je propose :

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&, n&, oPlg As Range, oCel As Range
   With Target.Areas
      For i = 1 To .Count
         n = WorksheetFunction.Max(n, .Item(i).Rows.Count + .Item(i).Row - 1)
      Next i
   End With
   With Range("C3") [COLOR="SeaGreen"]'Range("coin_supérieur_gauche")[/COLOR]
      n = WorksheetFunction.Max(1, WorksheetFunction.Min(Columns.Count - .Column + 1, Cells(WorksheetFunction.Max(n, Cells(Rows.Count, .Column).End(xlUp).Row), .Column).Row - .Row + 1))
      Set oPlg = .Resize(n, n)
   End With
   If Not Intersect(Target, oPlg) Is Nothing Then
      Application.EnableEvents = False
      For Each oCel In Intersect(Target, oPlg)
         With Range(oPlg.Cells(1, 1), oCel)
            If .Rows.Count > .Columns.Count Then
               On Error Resume Next
               oPlg.Cells(1, 1).Offset(.Columns.Count - 1, .Rows.Count - 1).Value = oCel.Value
               On Error GoTo 0
            End If
         End With
      Next
      Application.EnableEvents = True
   End If
End Sub[/B][/COLOR]

Et merci pour l'intérêt que vous portez à mes propositions. (Intérêt d'ailleurs réciproque, quoique votre passage à une version moderne me prive quelquefois de satisfaire ma curiosité...)​

ROGER2327
#3842

Jeudi 19 Gidouille 137 (Saint Sein, tautologue, SQ)
15 Messidor An CCXVIII
2010-W26-6T10:52:02Z

 

[quezaco]

Re : transposition matrice

bonjour roger2327,
J'ai rentré votre code dans le module mais une erreur d'execution 424 s'est produite (objet requis) au niveau de:
If Not Intersect(Target, oPlg) Is Nothing Then
Je débute en VBA et je ne comprends pas ce qu'il ce passe
Merci de votre réponse.

 

[pierrejean]

Re : transposition matrice

Re

Pour ROGER
Comment ne pas avoir d'interet pour vos propositions !!!

Voici ce que j'ai commis en version 97-2003

 

[ROGER2327]

Re : transposition matrice

Re...

bonjour roger2327,
J'ai rentré votre code dans le module mais une erreur d'execution 424 s'est produite (objet requis) au niveau de:
If Not Intersect(Target, oPlg) Is Nothing Then
Je débute en VBA et je ne comprends pas ce qu'il ce passe
Merci de votre réponse.

Étonnant. Voyez le classeur joint.
​

ROGER2327
#3844

Jeudi 19 Gidouille 137 (Saint Sein, tautologue, SQ)
15 Messidor An CCXVIII
2010-W26-6T11:11:45Z

 

[quezaco]

Re : transposition matrice

Messieurs vous êtes excellents.
Vos propositions sont aussi bonnes l'une que l'autre et vont m'eviter à coups sûrs des crampes aux bras.
Je vous souhaite une tres bonne journée et vous remercie encore pour votre travail.