Problème de tri automatique

[Verba_Tim]

Bonjour ^^
Je me suis mis au VBA il y a peu de temps et je me heurte à un problème qui m'embête et me fais des misères (le méchant...)

Donc pour situer mon problème, j'ai une liste de donné pouvant atteindre jusqu'à 100 000 lignes voir plus. La quantité d'information étant trop grosse, impossible de traité tout a la fois, étant donné que je dois les trier selon plusieurs critère. Jusque la pas de problème. J'ai triée mes données par heure dans 24 pages.

L'idée maintenant c'est de triée toutes ces données ( il s'agit d'un historique d'execution de tache plus précisément) dans les pages correspondantes, ce que j'ai fait, mais un problème subsiste encore et toujours Pour effectué le tri j'ai rangé mes données par ordre alphabétique, puis je sélectionne la parti concerné et enfin je coupe/colle vers la page de destination. Ou est le problème?

Et bien la quantité d'information dans ces pages étant encore trop importante (jusqu'à 7 000 lignes en moyenne), le tri ne se fait que dans un première parti. La suite se colle dans le désordre le plus complet, et en plus toutes les données à déplacer ne le sont pas. Auriez vous une idée d'optimisation? je bloque la...

Mon code:

sub tri_auto()
Page = 0
Do Until Page = 24

' Selection de la page horraire

Sheets("heure" & Page).Select

' tri par ordre alphabétique


Columns("E:E").Select
Range("E2").Activate
ActiveWorkbook.Worksheets("Heure" & Page).Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Heure" & Page).Sort.SortFields.Add Key:=Range("E2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Heure" & Page).Sort
.SetRange Range("A1:H962")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.SmallScroll Down:=36

' comptage, sélection et déplacement des lignes ou apparais ma fonction

nb_ligne = Application.CountIf(Range("E:E"), "Fonction[1.1]")
Range("A1:J" & nb_ligne).Select
Selection.Cut
Sheets("Voie 1").Select
Range("A" & ligne).Select
ligne = ligne + nb_ligne
ActiveSheet.Paste

' suppressions des lignes vides

Sheets("heure" & Page).Select
Selection.EntireRow.Delete

' on passe a la page suivante
Page = Page + 1

Loop

end sub

Cordialement,
Verba_Tim

 

[Guest]

Re : Problème de tri automatique

Bonjour Verba_Tim et bienvenue sur le forum,

Tu comprendras qu'avec ce que tu nous donnes , nous ne pouvons avancer qu'en aveugle et tâtonner.

Un fichier réduit en exemple avec la macro et des données anonymisés serait le bienvenue.

En tous cas il me semble que ta macro fonctionnerait plus rapidement comme-ci dessous.
Ne t'attends pas à ce que cela fonctionne du premier coup, il y a certaines choses que je n'ai pu deviner. Par exemple pourquoi mettre une clef de tri sur A2 et plus loin Header:=xlNo

Sub tri_auto()
    Page = 0
    Do Until Page = 24
        ' Selection de la page horraire
        With Sheets("heure" & Page)
        ' tri par ordre alphabétique
                       With .Sort
                .SortFields.Clear
                .SortFields.Add Key:=Range("E2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SetRange Range("A1:H962") 'A quoi correspond cette plage? pourquoi ne trier que jusqu'à la ligne 962?
                .Header = xlNo
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
 
        ' comptage, sélection et déplacement des lignes ou apparais ma fonction
        nb_ligne = Application.CountIf(Range("E:E"), "Fonction[1.1]")
        With .Range("A1:J" & nb_ligne)
            .Cut Destination:=Sheets("Voie 1").Range("A" & ligne).Select
            ' suppressions des lignes vides
            .EntireRow.Delete
        End With
        ' on passe a la page suivante
        Page = Page + 1
    Loop
End Sub

A te relire

 

[Verba_Tim]

Re : Problème de tri automatique

merci ^^ et oui effectivement si je te donne une petite cuillère pour creusé un fosser ça risque d'être dur....
Donc je remet ma macro actuel (qui fonctionne, mais pas correctement...):

Sub tri_auto()

ligne = 1
Page = 0
Columns("E:E").Select
Range("E2").Activate
ActiveWorkbook.Worksheets("Heure" & Page).Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Heure" & Page).Sort.SortFields.Add Key:=Range("E2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Heure" & Page).Sort
.SetRange Range("A1:H962")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.SmallScroll Down:=36
nb_ligne = Application.CountIf(Range("E:E"), "fonction[1.1]")
Range("A1:J" & nb_ligne).Select
Selection.Cut
Sheets("fonction 1").Select
Range("A" & ligne).Select
ligne = ligne + nb_ligne
ActiveSheet.Paste
Sheets("heure" & Page).Select
Selection.EntireRow.Delete

End Sub


et un exemple de fichier a traiter (j'ai raccourci un peu... il fait normalement 7600 ligne environ)


Edit: je viens de voir ta remarque sur le quantité de ligne... en effet je ne sais pas pourquoi ^^' c'est certainement du au fait que j'ai tiré cette partie d'un enregistrement automatique (de ma macro). Je test avec un nombre de ligne plus grand et je te dirai ce qu'il en est ^^ merci

 

[Guest]

Re : Problème de tri automatique

Re,

En fait tu veux faire une extraction filtrée sur la colonne F c'est ça?

A+

 

[Verba_Tim]

Re : Problème de tri automatique

Re ^^ colonne E en fait, mais dans le principe c'est ca ^^

 

[Guest]

Re : Problème de tri automatique

Re,

D'accord mais comment tu fais le lien entre les lignes Fonction 1.1 (ou fonction 2.3) par exemple et leur feuille de destination?

L'idée est de laisser excel faire ce qu'il sait bien faire: extraire les données et les coller sur d'autre feuilles en automatisant les filtres élaboré.

Pour la question du tri il faut que SetRange corresponde à la totalité de la plage, de cette façon:

    Dim plage As Range
    
    With ActiveWorkbook.Worksheets("Heure8")
        Set plage = .Range("A1").CurrentRegion
        With .Sort
        .SortFields.Clear
        .SortFields.Add Key:=plage.Offset(, 4).Resize(, 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange plage
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        End With
    End With

A te relire avec des explications plus claires.

A+

 

[Verba_Tim]

Re : Problème de tri automatique

Bon et bien apparement ça marche ^^'
Il fallait juste changé l'étendue de la plage... j'ai honte ^^

Merci beaucoup Hasco

Pour répondre a ta question à propos des liens tout est dans cette petite partie du code:

1-Range("A1:J" & nb_ligne).Select
2-Selection.Cut
3-Sheets("fonction 1").Select
4-Range("A" & ligne).Select
5-ligne = ligne + nb_ligne
6-ActiveSheet.Paste

Si je décortique:
1- me permet de sélectionner la plage de donné contenant la chaine "fonction1"
2- je coupe cette plage
3- je me place dans la page de destination
4- je sélectionne la ligne libre a partir de laquelle je vais coller ma liste
5- j'incrémente ma valeur ligne pour pouvoir acceuillir la prochaine tourné de ligne
6- je colle dans la page active

^^ et voila le travaille ^^

Merci encore pour ton aide ^^

A+

Ps: si je n'est pas été assez clair dit le moi ^^' ou si tu as une autre question... ça marche aussi