Imputer points a chaque partie

**apdf1** · 02/10/2011, 16h03

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

**mercatog** · 02/10/2011, 17h38

Bonjour
Une proposition (selon ma compréhension)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**jfontaine** · 02/10/2011, 17h49

bonjour,

Une autre solution en utilisant les formules

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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)

**apdf1** · 02/10/2011, 18h35

Bonjour jfontaine,

Je vous remercie beaucoup.

Sa marche Nickel

Bonne soiré

**apdf1** · 04/10/2011, 15h47

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

**mercatog** · 05/10/2011, 00h39

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**apdf1** · 05/10/2011, 10h11

Bonjour Mercatoq

Je te remercie super sympa ...

Bonne journée

@+

Max

**apdf1** · 13/10/2011, 11h18

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

**mercatog** · 15/10/2011, 17h49

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**apdf1** · 17/10/2011, 20h48

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

@+
Max

Imputer points a chaque partie [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager