Macro pour transposition

[TOINE38]

Bonjour,

Je récupère des données d'un suivi de production sur plusieurs paramètres mais qui s'enregistrent ligne par ligne et de ce fait j'ai du mal à avoir une lisibilité de la production. Mon besoin serait de créer une macro qui transforme ces lignes en un tableau, mais pour mon niveau c'est beaucoup trop compliqué.
Ci joint un extrait des données dans le fichier pour mieux comprendre le besoin. En feuil1 les données tel qu'elles sont enregistrées en feuil 2 le résultat que je souhaiterais.
Merci a tous ceux qui voudrons bien 'aider sur ce sujet.

En vous souhaitant a tous une bonne journée

cordialement

Toine38

 

[Dranreb]

Re : Macro pour transposition

Bonjour.

Ce code dans le module Feuil2 donne un résultat semblable.

Option Explicit

Private Sub Worksheet_Activate()
Dim Te(), Ts(), Le&, Ls&, C, D As New Dictionary, H As Date
Te = Feuil2.[A1].Resize(, Feuil2.[IV1].End(xlToLeft).Column).Value
For C = 2 To UBound(Te, 2): D(Te(1, C)) = C: Next C
ReDim Ts(1 To 1000, 1 To UBound(Te, 2))
Te = Feuil1.[A2:C2].Resize(Feuil1.[A60000].End(xlUp).Row - 1).Value
For Le = 1 To UBound(Te)
   If Te(Le, 2) <> H Then H = Te(Le, 2): Ls = Ls + 1: Ts(Ls, 1) = H
   If D.Exists(Te(Le, 1)) Then Ts(Ls, D(Te(Le, 1))) = Val(Te(Le, 3))
   Next Le
Feuil2.Rows("2:1000").Delete
Feuil2.Columns(1).NumberFormat = "m/d/yyyy h:mm"
Feuil2.[A2].Resize(Ls, UBound(Ts, 2)).Value2 = Ts
End Sub

Nécessite la référence Microsoft Scripting Runtime

 

[TOINE38]

Re : Macro pour transposition

Bonjour Dranreb,

Merci d'avoir le temps de m'aider à résoudre mon problème, mais voila le code fourni plante et me renvoi une erreur d'excution 13 a la ligne : Te = Feuil2.[A1].Resize(, Feuil2.[IV1].End(xlToLeft).Column).Value

Je ne sais pas ce qui ne vas pas ?

Merci d'avance si tu as une explication

Cordialement

Toine38

 

[Dranreb]

Re : Macro pour transposition

Chez moi ça marche sur votre fichier. Essayez en remplaçant provisoirement :

'Te = Feuil2.[A1].Resize(, Feuil2.[IV1].End(xlToLeft).Column).Value
Te = Feuil2.[A1:AJ1].Value

Vérifiez que Feuil2 est bien, comme dans votre classeur joint, le nom de l'objet VBA Worksheet de la rubrique Microsoft Excel Objets qui représente la feuille Excel devant recevoir le résultat et portant déjà les titres de colonnes.

 

[TOINE38]

Re : Macro pour transposition

Bonsoir Dranreb,

merci pour ton aide sur ce sujet, mais j'ai testé ta modification, mais malheureusement je n'ai que la colonne temps uniquement qui s'est mis dans la feuil2 !!
Ci joint le fichier.

Je n'arrive pas à comprendre ou cela bug.

cordialement

Toine38

 

[Dranreb]

Re : Macro pour transposition

Bonsoir.

Ç'est pourtant évident: ça bogue parce que je n'ai jamais prévu l'inventaire des codes à prendre de la colonne A. Ils étaient supposés préfigurer en titres dans la feuille réceptrice.
S'il les faut tous, et s'il faut en faire l'inventaire, il va falloir quelques modules de service en plus.
À moins qu'ils puissent rester classés par ordre de première apparition dans la liste. Alors on peut le faire comme ça :

Private Sub Worksheet_Activate()
Dim Te(), Ts(), Tk(), Le&, Ls&, C, D As New Dictionary, H As Date
Te = Feuil1.[A2:C2].Resize(Feuil1.[A60000].End(xlUp).Row - 1).Value
C = 1
For Le = 1 To UBound(Te)
   If Not D.Exists(Te(Le, 1)) Then C = C + 1: D(Te(Le, 1)) = C
   Next Le
ReDim Ts(1 To 1000, 1 To D.Count + 1)
Tk = D.Keys
For C = 2 To UBound(Ts, 2): Ts(1, C) = Tk(C - 2): Next C
Ls = 1
For Le = 1 To UBound(Te)
   If Te(Le, 2) <> H Then H = Te(Le, 2): Ls = Ls + 1: Ts(Ls, 1) = H
   If D.Exists(Te(Le, 1)) Then Ts(Ls, D(Te(Le, 1))) = Val(Te(Le, 3))
   Next Le
Feuil2.Rows("1:1000").Delete
Feuil2.Columns(1).NumberFormat = "m/d/yyyy h:mm"
Feuil2.[A1].Resize(Ls, UBound(Ts, 2)).Value2 = Ts
End Sub

 

[TOINE38]

Re : Macro pour transposition

Bonjour Dranreb,

Merci c'est parfais, tu es génial.
Je ne suis pas un expert comme toi et de ce fait je n'ai pas tout compris ton code .
Mais l'important est que cela fonctionne.

encore mille fois merci

Bon weekend.

Toine38