Trier un tableau sur VBA

Salut Denis,

Salut Steelson,

je passerai sur les détails lamentables de la mise au point de ce code dont l'idée était déjà claire dans ma tête... vendredi soir!

La vie n'est pas toujours un long fleuve tranquille...

  • je trie d'abord la BDD d'après les zones puis les points ;
  • dans la feuille 'Extract', j'éclate ce tri par groupes de 3 colonnes (noms,points,n° choix) avec en en-tête la zone et le nombre de places ;
  • ensuite, je sors la grosse Bertha (mieux vaut un i5 qu'un AT386, hein...) ;
L'idée :
  • zone par zone, pour chaque individu placé en ordre utile selon le nombre de place, une boucle DO...LOOP scanne le tableau, cherchant les autres choix de l'individu (FIND...FINDNEXT) et élimine les choix avec un n° supérieur, inutiles à conserver puisque sa place est déjà assurée à un meilleur choix ;
  • cela fait donc remonter d'un cran les demandes des autres individus ;
  • une élimination entraîne un rebouclage complet du tableau via une première boucle DO...LOOP principale.

Actuellement, d'après le fichier fourni:

  • tri en 'BDD' et préparation du tableau en 'Extract' = +- 15" ;
  • calcul principal = +- 15' ;
  • affichage des résultats = +- 90"

Les résultats, encore à finasser, s'inscrivent en 'BDD'.

Ce serait de bon augure si Steelson et moi avions les mêmes résultats!

Un double-clic en 'Extract' [A1] démarre la macro.

    'Calcul
    Do
        Application.ScreenUpdating = False
        iRep = 0
        For x = 1 To Cells(1, Columns.Count).End(xlToLeft).Column - 1 Step 3
            For y = 2 To 1 + CInt(Cells(1, x + 1))
                If Cells(y, x) <> "" And Cells(y, x).Font.Bold = False Then
                    iFlag = 0
                    iLevel = CInt(Cells(y, x + 2))
                    With UsedRange
                        Set rCel = .Find(what:=Cells(y, x), lookat:=xlWhole, searchdirection:=xlNext)
                        If Not rCel Is Nothing Then
                            sAddress = rCel.Address
                            Do
                                If CInt(rCel.Offset(0, 2).Value) > iLevel Then
                                    iRep = 1:  iFlag = 1
                                    rCel.Resize(1, 3).Delete shift:=xlUp
                                End If
                                Set rCel = .FindNext(rCel)
                            Loop While Not rCel Is Nothing And rCel.Address <> sAddress
                        End If
                    End With
                    If iFlag = 0 Then Cells(y, x).Font.Bold = True
                End If
            Next
        Next
        Application.ScreenUpdating = True
        Dummy = DoEvents()
    Loop Until iRep = 0

Curieux de connaître la suite...

A+

8denis-xlsm.xltm (924.04 Ko)

Bravo curulis57 ...

je vais l'appliquer sur mon je d'essai et comparer.

une boucle DO...LOOP scanne le tableau, cherchant les autres choix de l'individu (FIND...FINDNEXT) et élimine les choix avec un n° supérieur, inutiles à conserver puisque sa place est déjà assurée à un meilleur choix ;

quoique ...

c'est là où je me pose des questions !

Certes Denis a bien écrit

Pour départager 2 fonctionnaires qui font le même choix, on tient compte du barème ("points").

Exemple :

  • un fonctionnaire A demande Paris sur son choix n°6 et a 100 points
  • un fonctionnaire B demande Paris sur son choix n°1 et a 50 points
Ici, le fonctionnaire A sera prioritaire pour Paris par rapport au fonctionnaire B puisque son nombre de points est plus élevé.

car si le fonctionnaire A a un choix n°5 pour Lille avec 120 points, si ce choix est retenu pour lui alors il libère Paris (libérée, délivrée !)

C'est donc bien un truc à se tordre les neurones !

Salut Steelson,

déjà aux commandes?

Je ne supprime les choix d'un n° supérieur QUE si un individu est déjà bien placé en ordre utile ailleurs d'où il ne pourra plus être délogé.

En ordre utile veut donc dire dans les x premiers selon le nombre de places x de cette zone.

Le fonctionnaire à 100 pts. sur Paris bien placé sur Paris, choix n°6, ne verra pas son choix n°5 disparaître puisque ce choix peut encore remonter en ordre utile par le jeu de l'élimination d'autres fonctionnaires devant lui.

Denis devrait tester nos codes sur une demande de mutation antérieure pour comparer les résultats sur une base sûre.

A vos marques!

A+

ok, j'avais mal interprété ... donc très intéressant !

Je viens de lancer la macro de Steelson, je vous tiens au courant !

Par contre je n'arrive pas à lancer celle de curulis57, c'est sûrement tout bête à résoudre mais quand je la lance, ça me dit de sélectionner une macro (la liste est vide, donc je suis obligé d'en créer une). Même si je crée une macro du même nom que le sub de curulis57, cela m'en crée un autre, comme si la macro de curulis était ignorée...

En tout cas merci beaucoup à vous 2 pour tout ce boulot !

Les résultats, encore à finasser, s'inscrivent en 'BDD'.

Ce serait de bon augure si Steelson et moi avions les mêmes résultats!

Curieux de connaître la suite...

A+

Hello curulis !

Rien que la présentation et de déroulement sont stupéfiants ! Je suis scotché. Probablement plus rapide que moi.

J'ai un jeu de 1000 personnes, je vais regarder ... quoique je vais le faire sur 100 !

Tu as dû probablement refroidir ton unité centrale ... pas le PC, ta boîte à neurones et synapses.

Salut Denis, Steelson,

@Denis : à te lire, j'ai plus qu'une impression que tu as collé le code dans un module général (Module1) or il doit être collé dans le module VBA de 'Extract', feuille dans laquelle il faut double-cliquer sur [A1] pour démarrer la macro.

N'oublie pas de créer cette feuille 'Extract' et de renommer celle contenant la base de travail en 'BDD'... ou alors, changer dans le code les noms de feuille pour que ça tourne!

@Steelson : merci pour ton appréciation flatteuse .

Pas mécontent du résultat mais j'espère surtout qu'il sera positif.

J'essaie pour l'instant d'adapter le code à un tableau mais la mise au point est tout aussi lamentablement pénible!

A+

J'ai traduit mon code à un, tableau ... et je n'ai pas réussi à al faire fonctionner plus vite ! curieux ...

Avec 5000 individus, 6 choix par individu, 20 zones et 4900 places environ, ma petite config i3 a mis ~3 à 4 heures sur la version postée.

Je vais comparer les 2 versions (et surtout comprendre ta logique ... ce qui va me prendre un peu la tête). Mais je pense que pour cela il faut éviter d'avoir 2 fois les mêmes points, car selon que l'on privilégie un ex æquo ou un autre, cela peut avoir des conséquences en cascade.

C'est bon

En me basant sur extract (et non BDD et OK), sur un jeu réduit, nous avons strictement la même chose !

capture d ecran 158 capture d ecran 157

Salut Denis,

quoi de neuf?

Un point indécis a été soulevé par Steelson : quid lorsque 2 individus ont le même nombre de points pour une même zone?

Qui passe en priorité lorsque leur classement flirte avec le nombre de places disponibles ?

Pour l'instant, l'ordre est établi de façon sectaire lors du tri préalable au calcul mais y a-t-il un ou des autre(s) critère(s) de classement dont tu ne nous pas encore parlé?

A+

... et de mon côté (comme celui de Curulis), les neurones et synapses continuent d'interagir sur des cas marginaux ... à suivre ! Le sujet est hautement énergivore en matière grise

@curulis57 : Je viens de remplacer les données par les miennes de 151828 lignes et j'ai double cliquer sur A1. Je te tiens au courant !

2 individus ne peuvent pas avoir le même nombre de points s'il ne reste qu'une place. Un individu est avantagé manuellement avant le classement en comparant la situation précise des 2 individus avec d'autres critères que ceux indiqués.

@Steelson : J'ai lancé ton programme hier vers 09 h 30. Au début, le nombre d''affectés augmentait de 1 toutes les demies secondes à peu près, et maintenant c'est plutôt 1 toutes les minutes. J'en suis à 50466 affectés et c'est toujours en cours. Normalement je devrais en trouver environ 63000 à la fin.

Salut Denis,

pas aussi facile car pas prévu au programme!

Faudra plus de précisions quant à ta façon de procéder pour effectuer ce classement manuel (j'ai évidemment ma petite idée) pour effectuer cette manip' AVANT de lancer le calcul.

A+

@Steelson : J'ai lancé ton programme hier vers 09 h 30. Au début, le nombre d''affectés augmentait de 1 toutes les demies secondes à peu près, et maintenant c'est plutôt 1 toutes les minutes. J'en suis à 50466 affectés et c'est toujours en cours. Normalement je devrais en trouver environ 63000 à la fin.

Je ne suis malheureusement pas étonné. Comme Curulis je cherche des améliorations sur le temps car c'est exponentiel. Au-delà de 2000x6 choix c'est insupportable ! Il faudrait un cluster. Il est probable que son programme soit plus rapide grâce à l'organisation originale des données.

@curulis57 : il n'est pas nécessaire de reproduire ce traitement manuel puisqu'il est déjà pris en compte dans les données que je dois traiter.

@Steelson : C'est quoi un cluster ?

Un cluster est un groupe d'ordinateur ou de serveur qui permet de décupler la puissance de calcul.

Merci pour l'info

Bonjour,

Pour info le programme de Steelson en est à 55000 affectés actuellement, soit +4000 par rapport à hier à la même heure. Nous nous approchons du but ! Peut-être encore 2 jours à tourner.

Concernant le programme de Curulis57, je n'ai pas d'info sur l'état d'avancement, mais en tout cas ça tourne.

Je ne reviens pas avant mardi, donc je vous dis bon weekend et merci encore pour votre aide

Pas d’inquiétude, nos programmes neuronaux tournent aussi jour et nuit ! si si ...

Crevé, oui...

Rechercher des sujets similaires à "trier tableau vba"