Formule VBA générant un résultat

Version imprimable

26/02/2011, 22h54
kardo

Formule VBA générant un résultat

Bonjour à tous et merci par avance de toute l'aide que vous pourrez me fournir.
Je vous soumets ma requête :

J'ai une plage de données constitué de lettres qui font référence à un nombre de points. La formule générant le résultat est :

Code:

=SI(OU(A1="";B1="";C1="";D1="";E1="");"";(SI(AV7="i";1;SI(A1="p";2;SI(AV7="b";3;SI(A1="t";4;0))))+SI(B1="i";1;SI(B1="p";2;SI(B1="b";3;SI(B1="t";4;0))))+SI(C1="i";1;SI(C1="p";2;SI(C1="b";3;SI(C1="t";4;0))))+SI(D1="i";1;SI(D1="p";2;SI(D1="b";3;SI(D1="t";4;0))))+SI(E1="i";1;SI(E1="p";2;SI(E1="b";3;SI(E1="t";4;0))))))

Cette formule fait référence à 4 colonnes de notes et 4 niveaux (i, p, b, t)

Je souhaiterais que ma formule en VBA me détecte automatiquement le nombre de colonnes de notes, que soit défini au préalable le nombre de niveaux d'évaluation (4 à 6) et que le résultats soit automatiquement inscrit dans la cellule correspondant à chaque élève.

J'espère avoir été assez clair.

Merci par avance.
26/02/2011, 23h21
mercatog

Non pas clair, il serait mieux de faire une description détaillée (sans la formule)
26/02/2011, 23h34
kardo

Bonjour,

Comme un exemple vaut mieux qu'un long discourt, voici un extrait du fichier :

http://uploading.com/files/1c2b3ffa/Note.xlsx/

Je souhaite donc que les résultats de la colonne I soit générés en fonction du nombre de colonne insérer, dans l'exemple de B à H donc 7 critères d'évaluation et en fonction du nombre de niveau d'appréciation 4 ou 5 ou 6. Ici la cellule I3, donne le nombre de niveau désiré :
- si 4 est choisi alors les niveaux seront n, i, b, t
- si 5 est choisi alors les niveaux seront n, i, p, b, t
- si 6 est choisi alors les niveaux seront n, i, p, m, b, t.

Le but étant de générer une note sur 20 points en fonction du nombre de critère et du nombre de niveaux d'appréciation

J'espère avoir été plus clair.

Voila une proposition pour laquelle on utilise des listes de validation et l'évènement Change de la feuille.
- A chaque saisie d'un élève en colonne A, on crée des listes de validation de B à H sur la même ligne. Les items de cette liste sont en fonction du niveau d'appréciation en I3.
- A chaque entrée d'un critère (à l'aide de la liste de validation), la note est insérée dans la colonne I
Codes à mettre dans le module de la feuille:

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
29
30
31
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Niv As Byte
Dim Crit As String
 
If Target.Count = 1 And Target.Row >= 5 Then
    If Target.Column = 1 Then
        Crit = "n,i,p,b,t,m"
        Niv = Range("I3").Value
        Crit = Left(Crit, 2 * Niv - 1)
        With Range("B" & Target.Row & ":H" & Target.Row).Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Crit
        End With
    Else
        If Target.Column <= 8 Then Range("I" & Target.Row) = Sigma(Range("B" & Target.Row & ":H" & Target.Row))
    End If
End If
End Sub
 
'Fonction qui calcule la note finale sur 20
Private Function Sigma(Rng As Range) As Integer
Dim n As Integer
Dim c As Range
Dim Crit As String
 
Crit = "n,i,p,b,t,m"
For Each c In Rng
    n = n + (InStr(Crit, c.Value) - 1) / 2
Next c
Sigma = n * 4 / 7
End Function

27/02/2011, 00h55
kardo

Déjà je te remercie pour le temps que tu as consacré à ma demande.

Je ne veux pas abuser mais pourrais tu compléter le fichier que j'ai mis en exemple avec les macros car je ne sais pas comment les insérer.

Merci par avance

Bon, j'ai un peu modifié le code précédent pour tenir en compte le nombre effectif des appréciations

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
29
30
31
32
33
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Niv As Byte
Dim Crit As String
 
If Target.Count = 1 And Target.Row >= 4 Then
    Niv = Range("I2").Value
    If Target.Column = 1 Then
        Crit = "n,i,p,b,t,m"
        Crit = Left(Crit, 2 * Niv - 1)
        Range("A" & Target.Row & ":I" & Target.Row).Borders.LineStyle = xlContinuous
        With Range("B" & Target.Row & ":H" & Target.Row).Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Crit
        End With
    Else
        If Target.Column <= 8 And Range("A" & Target.Row) <> "" Then Range("I" & Target.Row) = Sigma(Range("B" & Target.Row & ":H" & Target.Row), Niv)
    End If
End If
End Sub
 
Private Function Sigma(Rng As Range, Niv As Byte) As Double
Dim Coef As Byte
Dim n As Integer
Dim c As Range
Dim Crit As String
 
Crit = "n,i,p,b,t,m"
Coef = Rng.SpecialCells(xlCellTypeConstants).Count
For Each c In Rng.SpecialCells(xlCellTypeConstants)
    n = n + (InStr(Crit, c.Value) - 1) / 2
Next c
Sigma = Application.RoundUp(n * 20 / (Coef * (Niv - 1)), 2)
End Function

Ci-joint Fichier démo

27/02/2011, 01h48
kardo

Je viens de tester le fichier.
Cela pose un problème lors de l'insertion ou de la suppression d'une colonne Critère : le résultat généré de correspond plus à rien et ne s'insère plus dans la bonne cellule.
De plus, la liste déroulante ne se modifie pas en fonction de la valeur contenue dans I2.
Est-il possible de mettre la colonne I (total des points) en relatif ainsi que la cellule I2, de manière à pouvoir insérer des colonnes critères ?

Bonjour
Pas besoin des messages privés, c'est plus un dérangement qu'autre chose.
Pour tes nouvelles données, j'ai pu modifier le fichier, mais ma question est: quel est le but de tes questions ici? tu veux apprendre vba ou simplement que quelqu'un te fasse ton travail?
Je dis ça parce que si tu essayais de comprendre la piste de code qu'on te file, tu pourrais adapter à tes besoins.
Nomme ta cellule I2 (où sera saisi le niveau) Niveau (Tu peux là mettre une liste de validation pour choisir 4, 5 ou 6)
Ici le code expliqué en tenant compte des dernières informations

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Col As Integer, LastLig As Integer
Dim Plage As Range, c As Range
Dim Niv As Byte
 
Niv = Range("Niveau").Value                                          'le niveau 4, 5 ou 6
Col = Range("Niveau").Column                                         'la colonne des notes (variable du fait de l'insertion ou suppression de colonnes
If Target.Count = 1 And Target.Row >= 4 Then                         'si UNE SEULE cellule est changée au dela de la ligne 4
    Set Plage = Range(Cells(Target.Row, 2), Cells(Target.Row, Col - 1))    'Plage: la ligne à partir de la colonne B jusqu'à l'avant dernière colonne
    'Ajout élève: Création des listes de validation sur la ligne en cours
    If Target.Column = 1 Then                                        'Si la colonne A est modifiée (ajout ou modification du nom d'un élève)
        Call LstValid(Plage, Niv)                                    'on appelle la procédure de création des listes de validation sur la ligne en cours
        Plage.Offset(0, -1).Resize(1, Plage.Count + 2).Borders.LineStyle = xlContinuous    'on trace les bordures
    'Choix critère: calcul de la note (dernière colonne)
    ElseIf Target.Column > 1 And Target.Column < Col And Range("A" & Target.Row) <> "" Then    'son on modifie les critere dans une cellule de la plage B jusqu'à l'avant dernière colonne
        Cells(Target.Row, Col).Value = Sigma(Plage, Niv)             'dans la dernière colonne on insère la calcul de la note à l'aide de la fonction Sigma
    End If
    Set Plage = Nothing
'Changement de niveau: mise à jour de toutes les listes de validation des critères
ElseIf Target.Address = Range("Niveau").Address Then
    LastLig = Cells(Rows.Count, 1).End(xlUp).Row
    Set Plage = Range(Cells(4, 2), Cells(LastLig, Col - 1))
    Call LstValid(Plage, Niv)
    Set Plage = Nothing
    'Ajout ou suppression d'une colonne: Mise à jour des notes
ElseIf Target.Rows.Count = ActiveSheet.Rows.Count Then
    LastLig = Cells(Rows.Count, 1).End(xlUp).Row
    For Each c In Range(Cells(4, Col), Cells(LastLig, Col))
        c.Value = Sigma(Range(Cells(c.Row, 2), Cells(c.Row, Col - 1)), Niv)
    Next c
End If
End Sub
 
'Fonction de calcul des notes
Private Function Sigma(Rng As Range, Niv As Byte) As Double
Dim Crit As String
Dim Coef As Byte
Dim n As Integer
Dim c As Range
 
Crit = "N,I,P,B,T,M"
Coef = Rng.Count
For Each c In Rng
    n = n + (InStr(Crit, c.Value) - 1) / 2
Next c
Sigma = Application.RoundUp(n * 20 / (Coef * (Niv - 1)), 2)
End Function
 
'Sub de création des listes de validation
Private Sub LstValid(Rng As Range, ByVal Niv As Byte)
Dim Crit As String
 
Crit = "N,I,P,B,T,M"
Crit = Left(Crit, 2 * Niv - 1)
With Rng.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Crit
End With
End Sub

27/02/2011, 20h49
kardo

Merci pour ta réponse. Je suis désolé mais l'ensemble des instructions me demande beaucoup de temps pour les comprendre puisque je n'ai pas sous la main de ressource simple pour expliquer chacune des fonctions.
Peux tu glisser le fichier exemple en pièce jointe avec ton nouveau code ?
Bien cordialement et avec tes mes remerciements.
27/02/2011, 20h54
mercatog

Bonjour
Non, je ne peux pas glisser ou faire glisser le fichier.
Tu remplace le code précédent par le nouveau.
Si tu as des question techniques précises sur le code, tu n'as qu'à les poser
les forumistes sont là pour te guider, t'orienter ou t'aider. En contre partie, tu devrais faire un minimum de lectures, d'exercices et d'applications.
A quoi te servira un code réalisé par autrui au cas où tu es devant un bug que tu n'arrive pas à pallier.
28/02/2011, 07h55
kardo

Merci cela fonctionne très bien et ton code est très bien expliqué. Je vais essayer d'insérer une validation comme tu l'as suggéré par choix pour Niveau
Merci encore

J'essaie de poursuivre ton travail pour l'adapter à ma feuille de calcul. Pour cela, je dois rendre tout référence aux colonnes et aux cellules relatives, seulement j'ai un soucis pour récupérer la référence (lettre) précédente d'une colonne de ma variable "First" qui peut être AA, AB, ... à cette endroit du code : ElseIf Target.Column > ColFirst - 1 And Target.Column < Col And Range( ? & Target.Row) <> "" Then

Auriez-vous une solutions ?

Voici le code :

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Col As Integer, LastLig As Integer, ColFirst As Integer, LigFirst As Integer
Dim Plage As Range, c As Range
Dim Niv As Byte
 
Niv = Range("Niveau").Value
Col = Range("Niveau").Column                                         'la colonne des notes (variable du fait de l'insertion ou suppression de colonnes
ColFirst = Range("First").Column
LigFirst = Range("First").Row
 
If Target.Count = 1 And Target.Row >= 4 Then                         'si UNE SEULE cellule est changée au dela de la ligne 4
    Set Plage = Range(Cells(Target.Row, ColFirst), Cells(Target.Row, Col - 1))    'Plage: la ligne à partir de la colonne B jusqu'à l'avant dernière colonne
    'Ajout élève: Création des listes de validation sur la ligne en cours
    If Target.Column = ColFirst - 1 Then                                        'Si la colonne A est modifiée (ajout ou modification du nom d'un élève)
        Call LstValid(Plage, Niv)                                    'on appelle la procédure de création des listes de validation sur la ligne en cours
        Plage.Offset(0, -1).Resize(1, Plage.Count + 2).Borders.LineStyle = xlContinuous    'on trace les bordures
    'Choix critère: calcul de la note (dernière colonne)
    ElseIf Target.Column > ColFirst - 1 And Target.Column < Col And Range( ? & Target.Row) <> "" Then    'son on modifie les critere dans une cellule de la plage B jusqu'à l'avant dernière colonne
        Cells(Target.Row, Col).Value = Sigma(Plage, Niv)             'dans la dernière colonne on insère la calcul de la note à l'aide de la fonction Sigma
    End If
    Set Plage = Nothing
'Changement de niveau: mise à jour de toutes les listes de validation des critères
ElseIf Target.Address = Range("Niveau").Address Then
    LastLig = Cells(Rows.Count, 1).End(xlUp).Row
    Set Plage = Range(Cells(LigFirst, ColFirst), Cells(LastLig, Col - 1))
    Call LstValid(Plage, Niv)
    Set Plage = Nothing
    'Ajout ou suppression d'une colonne: Mise à jour des notes
ElseIf Target.Rows.Count = ActiveSheet.Rows.Count Then
    LastLig = Cells(Rows.Count, 1).End(xlUp).Row
    For Each c In Range(Cells(LigFirst, Col), Cells(LastLig, Col))
        c.Value = Sigma(Range(Cells(c.Row, ColFirst), Cells(c.Row, Col - 1)), Niv)
    Next c
End If
End Sub
 
'Fonction de calcul des notes
Private Function Sigma(Rng As Range, Niv As Byte) As Double
Dim Crit As String
Dim Coef As Byte
Dim n As Integer
Dim c As Range
 
Crit = "N,I,P,B,T,M"
Coef = Rng.Count
For Each c In Rng
    n = n + (InStr(Crit, c.Value) - 1) / 2
Next c
Sigma = Application.RoundUp(n * 20 / (Coef * (Niv - 1)), 2)
End Function
 
'Sub de création des listes de validation
Private Sub LstValid(Rng As Range, ByVal Niv As Byte)
Dim Crit As String
 
Crit = "N,I,P,B,T,M"
Crit = Left(Crit, 2 * Niv - 1)
With Rng.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Crit
End With
End Sub

Merci

Je pense avoir trouver une solution sur le net qui a l'air de fonctionner avec :
Split(Columns(ColFirst - 1).Address(ColumnAbsolute:=False), ":")(1)

Mais je n'ai plus les niveaux 4, 5 et 6 qui se mettent à jour !! arf pénible lorsque l'on est débutant - 1

28/02/2011, 11h30
mercatog

Bonjour
C'est déjà pas mal, mais, explique davantage ce que tu souhaite faire avec ta cellule nommée "First", parce que ce n'est pas clair