Transposer donnees
Bonsoir a Tous
Je sollicite votre aide afin de re-organizer mes donnees comme je le souhaite , d'ailleurs je vous joint un fichier sur lequel il y a
le tableau original et en dessous le resultat souhaites. et s'il vous plait en vba
Je vous remercied'avance de votre support.
Bonsoir,
Sub Dehbi()
Dim d As Object, clr As Object, k, itm, aa, i%, j%, m%
Set d = CreateObject("Scripting.Dictionary")
Set clr = CreateObject("Scripting.Dictionary")
With ActiveSheet
aa = .Range("A1").CurrentRegion.Value2
For i = 2 To UBound(aa)
k = aa(i, 1) & ";" & aa(i, 2) & ";" & aa(i, 3)
d(k) = d(k) & ";'" & aa(i, 10)
If Not clr.exists(aa(i, 2)) Then clr(aa(i, 2)) = .Cells(i, 2).Interior.Color
Next i
End With
k = d.keys: itm = d.items
For i = 0 To UBound(k)
k(i) = Split(k(i), ";")
itm(i) = Replace(itm(i), ";", "", 1, 1): m = UBound(Split(itm(i), ";"))
j = IIf(m >= j, m + 1, j)
Next i
For i = 0 To UBound(k)
m = UBound(Split(itm(i), ";")) + 1
Do While m < j
itm(i) = itm(i) & ";": m = m + 1
Loop
itm(i) = Split(itm(i), ";")
Next i
With Worksheets("Feuil2")
.Range("A1").CurrentRegion.Clear
With .Range("A2").Resize(UBound(k) + 1, 3)
.Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(k))
.Columns(1).NumberFormat = "dd-mmm-yy"
.Columns(2).HorizontalAlignment = xlRight
End With
With .Range("D2").Resize(UBound(k) + 1, j)
.Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(itm))
.Columns.AutoFit
End With
.Range("A1").Resize(, 3).Value = WorksheetFunction.Index(aa, 1, Array(1, 2, 3))
For i = 1 To j
.Cells(1, i + 3) = "a" & i
Next i
With .Range("A1").CurrentRegion
With .Rows(1)
.HorizontalAlignment = xlCenter
.Interior.Color = RGB(218, 238, 243)
End With
For i = 0 To UBound(k)
.Cells(i + 2, 2).Interior.Color = CLng(clr(.Cells(i + 2, 2).Value))
Next i
.Borders.Weight = xlThin
End With
.Activate
End With
End Sub
Tu n'auras pas exactement ce que tu souhaites car 5 types différents au lieu de 3 : "A ", "A", "B ", "B", "C " (et pas de "C").
Cordialement.
bonjour
salut MFerrand
malgré la demande de VBA (étrange qu'on demande d'utiliser une caisse à outils complète alors qu'un tourne-vis standard suffit)
suggestion donc sans VBA, ni aucune formule non plus, ni rien de compliqué
facile à comprendre
facile à faire évoluer
le bonheur
note : j'ai mis des segments dans ton tableau, c'est plus pratique
note 2 : il y a des A non identiques en colonne 2 ! idem pour des B
note 3 : quel est le BUT de la présentation en lignes ? car elle est particulièrement contraire aux bonnes règles d'informatique.
Je vous remercie a vous deux de m'avoir eclairés sur ce sujet