Imputer points a chaque partie

Version imprimable

02/10/2011, 15h03
apdf1

Imputer points a chaque partie

Bonjour,
Voila je recherche un code un peut trop compliquer pour mois
Voila j'ai une colonne "F" avec une liste de joueur, des colonnes "K:Y" avec des points.
A chaque partie on ajoute les points que le joueur a gagné jusque la tous va bien.
Pour donné toute les chance aux 14 premier ,les joueur se voit doté d'une notes a chaque partie, soit pour le premier 130 points le second 120 points ainsi de suite.
Le problème est comment imputer les points au joueurs à chaque partie ?
~~J'ai joint mon fichier auquel il y a les explications car se n'est évident d'expliquer~~
Un très grand merci à tout ceux qui pourront m'aider...
Cordialement
Max

Bonjour
Une proposition (selon ma compréhension)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub Macro1()
Dim j As Byte, i As Byte, n As Byte
Dim m As Integer
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    'On efface la colonne G Point par Barèmes
    .Range("G4:G17").ClearContents
    'Pour chaqu colonne de K à Y (Analogiquement Partie j)
    For j = 11 To 25
        'Pour chaque ligne de 4 à 17 (Analogiquement concurrent i)
        For i = 4 To 17
            'Si le nombre de points du concurrent i pendant la partie j est renseigné
            If .Cells(i, j) <> "" Then
                'n Correspond au Rang du participant i dans la partie j
                n = Evaluate("RANK(" & .Cells(i, j).Address & "," & .Range(.Cells(4, j), .Cells(21, j)).Address & ")")
                'm est le nombre de points selon le barème du participant i pendant la partie j
                m = IIf(n = 14, 5, 140 - 10 * n)
                'en ajoute dans la cellule G, le nombre de points selon le barème du concurrent i
                .Cells(i, 7).Value = Val(.Cells(i, 7).Value) + m
            End If
        Next i
    Next j
    'On tri sur le points barèmes puis sur le total des points gagnés dans les parties
    .Range("F4:Y21").Sort Key1:=.Range("G4"), Order1:=xlDescending, Key2:=.Range("I4"), Order2:=xlDescending, Header:=xlNo
End With
End Sub

bonjour,

Une autre solution en utilisant les formules

Cette formule traite les parties 1 à 3 (même principe pour les autres parties
Code:

1 2 3 =DECALER($B$3;SI(ESTERREUR(RANG(K4;$K$4:$K$17));0;RANG(K4;$K$4:$K$17));0) +DECALER($B$3;SI(ESTERREUR(RANG(L4;$L$4:$L$17));0;RANG(L4;$L$4:$L$17));0 )+DECALER($B$3;SI(ESTERREUR(RANG(M4;$M$4:$M$17));0;RANG(M4;$M$4:$M$17));0)

02/10/2011, 17h35
apdf1

Bonjour jfontaine,

Je vous remercie beaucoup.

Sa marche Nickel

Bonne soiré
04/10/2011, 14h47
apdf1

Bonjour,

Suite a la proposition de code qui a fait mercatoq et que je remercie encore et ne pouvant pas joindre autrement que par ce site.

Pour commencer un grand merci du temps que tu ma consacrer.
j'aimerais si possible une petite modif au sujet des points, je m'explique.

Le premier à 130, le deuxième 120, le troisième 110, quatrième 105, cinquième 100, 6eme 95, 7éme 90, 8éme 85 jusqu'au 24 qui aura 05.

Un très grand merci d'avance

Cordialement
Max

Bonsoir
Changer l’équation de m (ligne 18)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub Macro1()
Dim j As Byte, i As Byte, n As Byte
Dim m As Integer
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    'On efface la colonne G Point par Barèmes
    .Range("G4:G27").ClearContents
    'Pour chaqu colonne de K à Y (Analogiquement Partie j)
    For j = 11 To 25
        'Pour chaque ligne de 4 à 27 (Analogiquement concurrent i)
        For i = 4 To 27
            'Si le nombre de points du concurrent i pendant la partie j est renseigné
            If .Cells(i, j) <> "" Then
                'n Correspond au Rang du participant i dans la partie j
                n = Evaluate("RANK(" & .Cells(i, j).Address & "," & .Range(.Cells(4, j), .Cells(27, j)).Address & ")")
                'm est le nombre de points selon le barème du participant i pendant la partie j
                m = IIf(n <= 3, 140 - 10 * n, 125 - 5 * n)
                'en ajoute dans la cellule G, le nombre de points selon le barème du concurrent i
                .Cells(i, 7).Value = Val(.Cells(i, 7).Value) + m
            End If
        Next i
    Next j
    'On tri sur le points barèmes puis sur le total des points gagnés dans les parties
    .Range("F4:Y27").Sort Key1:=.Range("G4"), Order1:=xlDescending, Key2:=.Range("I4"), Order2:=xlDescending, Header:=xlNo
End With
End Sub

05/10/2011, 09h11
apdf1

Bonjour Mercatoq

Je te remercie super sympa ...

Bonne journée

@+

Max
13/10/2011, 10h18
apdf1

Bonjour,

Suite à la création et la Modification de code qui a fait mercatoq et que je remercie infiniment je vous demanderais si possible en fonction de votre temps, encore une petite modif de dernière minute.
je viens de m'apercevoir que j'ai un problème au niveau de la distributions des points je m'explique:
En fait il y a 80 joueurs dans le club, les 24 premiers joueurs se voit attribuer des points en fonctions de leurs place et les joueurs suivant reçoivent 0 points.
Pour les 24 premiers joueurs aucun problème vous m'avez fait la modif nickel. Le problème et pour les joueurs suivant, il faudrait qu'ils se retrouvent avec 0 point, pour que les prochaines partie si un joueur qui se trouve avec 0 point et qu'il fait le meilleur score se voit attribuer 130 points et prenne sa place dans la liste et ainsi de suite.
Je ne s'est pas si je me suis bien expliquer pas toujours évident.
Pour commencer un grand merci du temps que vous m'avez consacrer.
Cordialement
Max

Bonjour
Tu devrais t'en sortir tout seul si tu avais compris le code, sinon, tu n'auras pas un sav constant.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub Macro1()
Dim j As Byte, i As Byte, n As Byte
Dim m As Integer
Const NbJ As Byte = 80 'Nombre de joueurs
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    'On efface la colonne G Point par Barèmes
    .Range("G4:G" & NbJ + 3).ClearContents
    'Pour chaqu colonne de K à Y (Analogiquement Partie j)
    For j = 11 To 25
        'Pour chaque ligne de 4 à 83 (Analogiquement concurrent i): 80 joueurs
        For i = 4 To NbJ + 3
            'Si le nombre de points du concurrent i pendant la partie j est renseigné
            If .Cells(i, j) <> "" Then
                'n Correspond au Rang du participant i dans la partie j
                n = Evaluate("RANK(" & .Cells(i, j).Address & "," & .Range(.Cells(4, j), .Cells(NbJ + 3, j)).Address & ")")
                'm est le nombre de points selon le barème du participant i pendant la partie j
                m = IIf(n <= 3, 140 - 10 * n, IIf(n <= 24, 125 - 5 * n, 0))
                'en ajoute dans la cellule G, le nombre de points selon le barème du concurrent i
                .Cells(i, 7).Value = Val(.Cells(i, 7).Value) + m
            End If
        Next i
    Next j
    'On tri sur le points barèmes puis sur le total des points gagnés dans les parties
    .Range("F4:Y" & NbJ + 3).Sort Key1:=.Range("G4"), Order1:=xlDescending, Key2:=.Range("I4"), Order2:=xlDescending, Header:=xlNo
End With
End Sub

17/10/2011, 19h48
apdf1

Bonsoir mercatoq
Je te remercie et te souhaite une bonne soirée

@+
Max