Trier un tableau selon les critères de celui-ci pour en recréer d'autres

Squoltahthx94

XLDnaute Occasionnel
Bonjour le forum,

Je trie des infos que je distribue dans 5 onglets (S0101, S0201, S0301, S0401, S0501) et je souhaite pour plus de lisibilité que les différent sites ( Essais 1, Essais 2 et Essais 3) soit ramené dans des tableaux pour chaque sites en respectant les critères suivant :

1 - Rouge
2 - Orange
3 - Jaune
4 - (vide)
ensuite pour les chaque critère ci-dessus (rouge, orange....) je dois les trier selon la date et heure (représentée en G).

Pour être plus clair je vous transmet un exemple :

Merci de votre retour:confused:
 

Pièces jointes

  • Classeur4.xlsm
    13.2 KB · Affichages: 61
  • Classeur4.xlsm
    13.2 KB · Affichages: 88
  • Classeur4.xlsm
    13.2 KB · Affichages: 76

JCGL

XLDnaute Barbatruc
Re : Trier un tableau selon les critères de celui-ci pour en recréer d'autres

Bonjour à tous,

Tes dates ne sont pas des dates : impossible à trier
Tu as la possibilité de créer tes propres listes de tri

A + à tous
 

Squoltahthx94

XLDnaute Occasionnel
Re : Trier un tableau selon les critères de celui-ci pour en recréer d'autres

bonjour,

Merci pour ta réponse mais hormis que mes dates ne sont pas des dates (ça je le savais) y a t il un moyen de créer les tableaux par critère 'essais 1', 'ess..... automatiquement car le fichier est d'un nombre de lignes assez conséquent et donc à faire au quotidien c'est assez pénible.

Merci d'avance
 

job75

XLDnaute Barbatruc
Re : Trier un tableau selon les critères de celui-ci pour en recréer d'autres

Bonjour Squoltahthx94, salut Jean-Claude :)

Telles qu'elles sont constituées, les "dates" se trient alphabétiquement sans problème.

Voyez le fichier joint et ce code VBA (Alt+F11) :

Code:
Option Explicit
Option Compare Text 'la casse n'a pas d'importance

Sub Tri()
Dim derlig&, plage As Range, i&, t, d As Object
derlig = [B3].End(xlDown).Row
If derlig = Rows.Count Then Exit Sub
Application.ScreenUpdating = False
Set plage = Range("A3:I" & derlig)
'---tableau préparatoire trié---
Range("A" & derlig + 1 & ":I" & Rows.Count).Delete xlUp 'RAZ
plage.Copy Cells(derlig + 1, 1)
Set plage = plage.Offset(plage.Rows.Count)
For i = 2 To plage.Rows.Count 'pour la 2ème clé de tri
  t = Trim(plage.Cells(i, 8))
  If t = "rouge" Then plage.Cells(i, 9) = 1
  If t = "orange" Then plage.Cells(i, 9) = 2
  If t = "jaune" Then plage.Cells(i, 9) = 3
  If t = "" Then plage.Cells(i, 9) = 4
Next
plage.Sort [B1], xlAscending, [I1], , xlAscending, [G1], xlAscending, xlYes
plage.Columns(9).ClearContents
'---liste des titres des tableaux---
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To plage.Rows.Count
  d(plage.Cells(i, 2).Value) = plage.Cells(i, 2).Value
Next
'---création des tableaux---
ActiveSheet.AutoFilterMode = False
For Each t In d.keys
  derlig = Cells(Rows.Count, 2).End(xlUp).Row
  Cells(derlig + 3, 2) = t
  Cells(derlig + 3, 2).Borders.LineStyle = 1 'bordures
  plage.AutoFilter 2, t 'filtre automatique
  plage.SpecialCells(xlCellTypeVisible).Copy Cells(derlig + 5, 1)
  plage.AutoFilter
Next
ActiveSheet.AutoFilterMode = False
plage.Delete xlUp
End Sub
Coquinerie : il y a un espace après ROUGE :rolleyes: d'où le Trim...

La macro peut être exécutée sur chaque feuille concernée.

Edit : pour info, en recopiant le tableau jusqu'à la ligne 18003, la durée d'exécution est de 1,90 s (Win XP/Excel 2003).

A+
 

Pièces jointes

  • Tri(1).xls
    82 KB · Affichages: 75
  • Tri(1).xls
    82 KB · Affichages: 79
  • Tri(1).xls
    82 KB · Affichages: 77
Dernière édition:

Squoltahthx94

XLDnaute Occasionnel
Re : Trier un tableau selon les critères de celui-ci pour en recréer d'autres

Merci ça marche parfaitement
Une question : si je veux que cette info s'applique à un onglet -> quel commande je dois employer (exemple onglet 'abcd')???

Merci bcp encore:eek:
 

job75

XLDnaute Barbatruc
Re : Trier un tableau selon les critères de celui-ci pour en recréer d'autres

Re,

Pour que la macro s'applique uniquement aux feuilles dont le nom est "S" suivi de 4 chiffres, ajouter en début de macro :

Code:
If Not ActiveSheet.Name Like "S####" Then Exit Sub
Et au lieu de boutons, on peut déclencher la macro Tri avec ces macros événementielles dans ThisWorkbook :

Code:
Private Sub Workbook_Open()
Tri
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Tri
End Sub
Fichier (2).

A+
 

Pièces jointes

  • Tri(2).xls
    82.5 KB · Affichages: 62
  • Tri(2).xls
    82.5 KB · Affichages: 65
  • Tri(2).xls
    82.5 KB · Affichages: 62

Discussions similaires

Statistiques des forums

Discussions
312 195
Messages
2 086 078
Membres
103 112
dernier inscrit
cuq-laet