[macro] classement sur excel

classement sur excel [macro] - VB/VBA/VBS - Programmation

Marsh Posté le 06-11-2007 à 00:47:25    

Bonsoir à tous,
 
Je voudrais faire un tableau qui fait 1 classement de rencontres sportives, j'ai trouvé et retouché une macro qui fait à peu près ce que je veux à quelques exceptions pres :  
la macro établit un tri des joueurs en fonction du score rentré ex :  
Pierre 50 1
Jean  20  2
Paul  10  3
le problème est qu'il faut rentrer le score manuellement à chaque fois.
mon score est calculé à partir d'un tableau victoires - défaites
je voudrais qu'il prenne en compte ce score la mais des que j'indique une formule dans ces cellules, le classement ne fonctionne plus , c'est à dire quand je change un score , le classement ne bouge pas.
je vous envois la macro ci-jointe pour être plus clair  
je ne suis pas un pro d'excel et des macros en l'occurence donc si quelqu'un pouvait m'aider ce serait tres sympa de sa part
merci d'avance
------------------------------------------------------------
 
Sub Triscore()
'
'
 
'pour une matrice des lignes 3 à 32
'avec en colonne A un index des joueurs,
'en colonne B leur nom et
'en colonne C le rang que l'on va remplir automatiquement
 
'classer selon le score
 
    Rows("3:7" ).Select
    Selection.Sort Key1:=Range("C3" ), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
         
' Mettre 1 au rang du premier en donnant comme rang le N° de ligne moins 2
        Range("D3" ).Select
    ActiveCell.FormulaR1C1 = "=ROW(RC[-2])-2"
 
' Au suivant mettre son N° de ligne -2 s'il est différent du précédent,
'sinon mettre comme le précédent
    Range("D4" ).Select
    ActiveCell.FormulaR1C1 = "=+IF(RC[-1]=R[-1]C[-1],R[-1]C,ROW(RC[-1])-2)"
     
'copier cette formule dans toute lma colonne score de la matrice
    Range("D4" ).Select
    Selection.AutoFill Destination:=Range("D4:D7" ), Type:=xlFillDefault
 
'Copier la colonne des scores et la coller en valeur (collage spécial valeur)
    Range("D3:D7" ).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'retrier les lignes en fonction de l'index des joueurs mais ce pourrait être par ordre alphabétique par exemple
    Rows("3:7" ).Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("A3" ), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A3" ).Select
End Sub
 
 
 
 
 

Reply

Marsh Posté le 06-11-2007 à 00:47:25   

Reply

Marsh Posté le 06-11-2007 à 01:25:53    

il n'est pas étonnant que ton dernier tri, après les formules, s'embrouille :  chaque n° est défini par les cellules au-dessus... du coup après tri, les lignes se mélangent et celles qui étaient jadis au-dessus changent de place.
 
Il faut que tu fasses tout par macro.
 
1/ le premier tri
2/ afffectation des n° :
 
dim A as integer
 
for A=3 to 7
  if A<>3 then
    if cells(A,3)=cells(A-1,3cells) then
      cells(A,4)=A.rows-2
    else
      cells(A,4)=cells(A-1,4)
    end if
  end if
next A
 
maintenant les n° sont inscrits en dur, tu peux donc trier comme bon te semble.

Reply

Marsh Posté le 06-11-2007 à 01:27:39    

Rectificatif...
 
dim A as integer
 
for A=3 to 7
  if A<>3 then
    if cells(A,3)<>cells(A-1,3) then
      cells(A,4)=A.rows-2
    else
      cells(A,4)=cells(A-1,4)
    end if
  end if
next A

Reply

Marsh Posté le 06-11-2007 à 02:14:54    

Tout d'abord, merci de m'avoir répondu si rapidement
cependant ça va te paraitre idiot mais je ne vois pas ou intégrer ton code code dans ma macro ou a la place de quoi je le mets?
sincerement je ne comprends pas trop son fonctionnement
merci encore de ton aide


---------------
Jeremy  -  
Reply

Marsh Posté le 06-11-2007 à 14:59:55    

Ton code modifié :
 
'1/ classement selon le score
 
Rows("3:7" ).Sort Key1:=Range("C3" ), Order1:=xlDescending, _
Header:=xlGuess
 
'2/ Affectation N° : N° de la ligne-2 ou N° précédent (cas égalité)
 
dim A as integer
 
for A=3 to 7
  if A<>3 then
    if cells(A,3)<>cells(A-1,3) then
      cells(A,4)=A.rows-2
    else
      cells(A,4)=cells(A-1,4)
    end if
  end if
next A
 
 
'3/ retrier les lignes en fonction de l'index des joueurs mais ce pourrait être par ordre alphabétique par exemple
 
Rows("3:7" ).Sort Key1:=Range("A3" ), Order1:=xlAscending, _  Header:=xlGuess
 
End Sub

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed