VBA Copier et trier avec multicritères

Résolu

Arnaud4181 Messages postés 4 Date d'inscription Statut Membre Dernière intervention -
Arnaud4181 Messages postés 4 Date d'inscription Statut Membre Dernière intervention - 16 oct. 2012 à 17:45

Bonjour,

Dans un fichier Excel, j'ai trois onglets :
Un onglet "Données sources"
Un onglet "Param"
Colonne A : la liste des participants
Colonne B : le numéro de l'atelier
Colonne C : la date de l'atelier
Colonne D : l'heure de l'atelier (format 00:00)
Un onglet "Par intervenants"

Dans l'onglet "données sources", je saisie les dates, participants, les lieux... et via VBA je renseigne plusieurs autres onglets (plusieurs autres onglets non détaillés ici) dont l'onglet "Par participants". Dans cet onglet, je rapatrie les données sources et les réorganise par participants (numéro de l'ateliers, dates, heures,...) à partir de la cellule B2 (pour "données sources" et "par intervenants")

J'utilise actuellement la macro suivante qui me fait le tri par intervenant :

Sub Listing()

Sheets("Param").Select

Lfin1 = Cells(1, "A").End(xlDown).Row
Cfin1 = 1
tab1 = Range(Cells(2, "A"), Cells(Lfin1, Cfin1)).Value
Lfin1 = Lfin1 - 1

Sheets("Données sources").Select

Lfin4 = Cells(2, "B").End(xlDown).Row
Cfin4 = Cells(2, "B").End(xlToRight).Column
tab4 = Range(Cells(3, "B"), Cells(Lfin4, Cfin4)).Value
Lfin4 = Lfin4 - 2

tot1 = 2

Sheets("Par intervenants").Select
'par intervenants

For i = 1 To Lfin1
For j = 1 To Lfin4

If tab1(i, 1) = tab4(j, 10) Then
tot2 = tot2 + 1
For w = 1 To Cfin4 - 1
Cells(tot2, w + 1) = tab4(j, w)
Next w
End If

Next j
Next i

For i = tot2 + 2 To 600
For w = 1 To Cfin4 - 1
Cells(tot2 + 1, w + 1) = ""
Next w
Next i

tot3 = 2

Je souhaiterai que ce tri soit fait sur plusieurs échelons : par intervenant, puis par date, puis par heure. Et je sèche...
Si quelqu'un à une idée?

Afficher la suite

A voir également:

VBA Copier et trier avec multicritères
Excel trier par ordre croissant chiffre - Guide
Comment copier une vidéo youtube - Guide
Super copier - Télécharger - Gestion de fichiers
Logiciel pour trier les photos automatiquement - Guide
Historique copier coller - Guide

4 réponses

Réponse 1 / 4

Arnaud4181 Messages postés 4 Date d'inscription Statut Membre Dernière intervention

J'aurai bien ajouté un fichier exemple mais je ne sais pas comment...

Réponse 2 / 4

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

bonjour,
pour joindre une pièce
mettre le classeur sans données confidentielles en pièce jointe sur
https://www.cjoint.com/
puis copier l'adresse du lien et la coller dans le message de réponse

idée sans avoir piocher ton code:
pour le tri sur 3 colonnes, essaies par l'enregistreur de macro et "traduit" en VBA

autres asrtuces

pour le confort visuel et la rapidité (gain: +/- 80x)
en début de code
application.screenupdating=false
(pas la peine de le remettre à True en fin de macro)

et évite le select à remplacer par (par ex)

With Sheets("Données sources") 
      Lfin4 = .Cells(2, "B").End(xlDown).Row 
      Cfin4 = .Cells(2, "B").End(xlToRight).Column 
      tab4 = .Range(.Cells(3, "B"), .Cells(Lfin4, Cfin4)).Value 
      Lfin4 = Lfin4 - 2 

    tot1 = 2  
end with

attention: ne pas oublier les points devant "range" et "cells"

Réponse 3 / 4

Arnaud4181 Messages postés 4 Date d'inscription Statut Membre Dernière intervention

Voilà le lien pour le fichier
https://www.cjoint.com/?BJqrdf6aGra

Réponse 4 / 4

Arnaud4181 Messages postés 4 Date d'inscription Statut Membre Dernière intervention

J'ai trouvé une solution barbare mais qui fonctionne

Je rajoute un Excel run avec la macro suivante

Sub Trier_inter()
'
'
Application.ScreenUpdating = False
'
Range("B2:K600").Select

ActiveWorkbook.Worksheets("Par intervenants").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Par intervenants").Sort.SortFields.Add Key:=Range( _
"K3:K600"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Par intervenants").Sort.SortFields.Add Key:=Range( _
"G3:G600"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Par intervenants").Sort.SortFields.Add Key:=Range( _
"H3:H600"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Par intervenants").Sort
.SetRange Range("B2:K600")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

Merci

Discussions similaires

dessin avec symbole clavier

Arobase (@)

comment faire une arobase

Arobase

Votre réponse

Discussions similaires