XL 2013 Tri

job75 à dit:

Re,

Maintenant avec VBA on peut tout faire cher ami.

Voyez le fichier joint et les macros des boutons :

Code:

Private Sub CommandButton1_Click() 'Tri croissant
With [Tableau7]
  If Intersect(ActiveCell.EntireColumn, .Cells) Is Nothing Then Exit Sub
  .Value = .Value 'supprime les formules
  .Sort ActiveCell, xlAscending, Header:=xlYes
End With
CommandButton1.Visible = False
CommandButton2.Visible = False
CommandButton3.Visible = True
End Sub

Private Sub CommandButton2_Click() 'Tri décroissant
With [Tableau7]
  If Intersect(ActiveCell.EntireColumn, .Cells) Is Nothing Then Exit Sub
  .Value = .Value 'supprime les formules
  .Sort ActiveCell, xlDescending, Header:=xlYes
End With
CommandButton1.Visible = False
CommandButton2.Visible = False
CommandButton3.Visible = True
End Sub

Private Sub CommandButton3_Click() 'Formules
Dim rc&, t, a(), i&, j&, x$
With [Tableau7]
  rc = .Rows.Count
  '---mémorisation des numéros--
  t = .Value
  ReDim a(1 To rc, 1 To 3)
  For i = 1 To rc
    a(i, 1) = t(i, 1): a(i, 2) = t(i, 2)
    For j = 3 To 6
      a(i, 2) = a(i, 2) & Chr(1) & t(i, j)
  Next j, i
  '---mise en place des formules---
  i = .Row - 1
  j = .Column - 1
  .Columns(2).Resize(, 5) = "=SUMIF(R" & i & "C2:R" & i & "C" & j & ",R" & i & ",RC2:RC" & j & ")"
  .Columns(7) = "=SUM(RC[-5]:RC[-3])"
  '---repositionnement correct des numeros---
  t = .Value
  For i = 1 To rc
    x = t(i, 2)
    For j = 3 To 6: x = x & Chr(1) & t(i, j): Next j
    For j = 1 To rc
      If x = a(j, 2) And a(j, 3) = "" Then
        t(i, 1) = a(j, 1)
        a(j, 3) = 1 'repérage en cas de doublon (sûrement rare)
        Exit For
      End If
  Next j, i
  .Columns(1) = t
End With
CommandButton1.Visible = True
CommandButton2.Visible = True
CommandButton3.Visible = False
End Sub

Le code du bouton "Formules" est assez trapu...

A+

Cliquez pour agrandir...