Classement

[PATPAT]

Bonjour,

je reformule une demande !

Quelle est la fonction à utiliser pour passer du tableau 1 au tableau 2 dans le fichier joint ?

Merci et mes excuses pour ma première demande trop imprécise.

Bon courage à tous !

 

[Ninter]

Re : Classement

Bonjour PATPAT,
Essayer la fonction transposer ensuite vous arrangez la disposition!
En espérant d'avoir compris votre demande.
Pour faire la fonction transposer, copier le tableau 1 puis dans la cellule ou on veut le résultat, faire clic droit -->collage special-->Cliquer Transposé (en bas à droite), puis vous pourriez modifier le tableau à votre guise.

Ninter

 

[R@chid]

Re : Classement

Bonjour @ tous,
Je t'ai donné une réponse ICI..
J'ai pas répondu à ta dernière question car elle était bête, tu n'as pas pris le temps pour voir les formules proposées.
@ + +

 

[job75]

Re : Classement

Bonjour PATPAT, salut Ninter, R@chid,

Si l'on veut traiter le cas général ce n'est pas évident, même en VBA.

Voyez le fichier joint avec cette macro :

Sub Classement()
Dim P1 As Range, P2 As Range, d As Object, i&, j As Variant, h&, k As Byte
Application.ScreenUpdating = False
Set P1 = Range("B4:D" & Range("B" & Rows.Count).End(xlUp).Row)
Set P2 = [K4].Resize(Rows.Count - 3, Columns.Count - 10)
P2.Clear 'RAZ
'---détermination des en-têtes de colonnes---
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To P1.Rows.Count
 d(P1(i, 1).Value) = ""
Next
P2(1, 2).Resize(, d.Count) = d.keys
P2(1, 2).Resize(, d.Count).Sort P2(1, 2), Orientation:=xlLeftToRight
'---création du tableau brut---
For i = 1 To P1.Rows.Count
  P2(i + 1, 1) = P1(i, 2)
  j = Application.Match(P1(i, 1), P2.Rows(1), 0)
  If IsNumeric(j) Then P2(i + 1, j) = P1(i, 3)
Next
P2.Sort P2(1), Header:=xlYes, Orientation:=xlTopToBottom
'---tri de chaque colonne---
For i = 2 To P1.Rows.Count + 1
  If P2(i, 1) <> "" And P2(i, 1) <> P2(i - 1, 1) Then
    h = Application.CountIf(P2.Columns(1), P2(i, 1))
    If h > 1 Then
      For j = 2 To d.Count + 1
        P2(i, j).Resize(h).Sort P2(i, j), Header:=xlNo
      Next
    End If
  End If
Next
'---suppression des lignes vides---
For i = P1.Rows.Count + 1 To 2 Step -1
  If Application.CountA(P2.Rows(i)) < 2 Then P2.Rows(i).Delete xlUp
Next
'--- mise en forme, fusion et bordures---
Application.DisplayAlerts = False
P2(1, 2).Resize(, d.Count).Borders.Weight = xlThin
P2(1, 2).Resize(, d.Count).HorizontalAlignment = xlCenter
For i = 2 To P1.Rows.Count
  If P2(i, 1) <> "" And P2(i, 1) <> P2(i - 1, 1) Then
    h = Application.CountIf(P2.Columns(1), P2(i, 1))
    P2(i, 1).Resize(h).Merge
    P2(i, 1).VerticalAlignment = xlCenter
    P2(i, 1).HorizontalAlignment = xlCenter
    For j = 1 To d.Count + 1
      For k = 7 To 10
        P2(i, j).Resize(h).Borders(k).Weight = xlThin
      Next
    Next
  End If
Next
End Sub

Il y a plusieurs tris et des suppressions de lignes...

A+

 

[job75]

Re : Classement

Re,

Compléments au cas où des cellules sont vides en colonne B, voir le fichier (2).

A+