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+