IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Formule VBA générant un résultat


Sujet :

Macros et VBA Excel

  1. #1
    Membre habitué
    Profil pro
    Inscrit en
    Février 2011
    Messages
    11
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2011
    Messages : 11
    Par défaut 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 : Sélectionner tout - Visualiser dans une fenêtre à part
    =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.

  2. #2
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Non pas clair, il serait mieux de faire une description détaillée (sans la formule)

  3. #3
    Membre habitué
    Profil pro
    Inscrit en
    Février 2011
    Messages
    11
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2011
    Messages : 11
    Par défaut
    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.

  4. #4
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    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 : 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
    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

  5. #5
    Membre habitué
    Profil pro
    Inscrit en
    Février 2011
    Messages
    11
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2011
    Messages : 11
    Par défaut
    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

  6. #6
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Bon, j'ai un peu modifié le code précédent pour tenir en compte le nombre effectif des appréciations
    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
    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

  7. #7
    Membre habitué
    Profil pro
    Inscrit en
    Février 2011
    Messages
    11
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2011
    Messages : 11
    Par défaut
    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 ?

  8. #8
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    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 : 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
    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

  9. #9
    Membre habitué
    Profil pro
    Inscrit en
    Février 2011
    Messages
    11
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2011
    Messages : 11
    Par défaut
    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.

  10. #10
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    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.

  11. #11
    Membre habitué
    Profil pro
    Inscrit en
    Février 2011
    Messages
    11
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2011
    Messages : 11
    Par défaut
    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

  12. #12
    Membre habitué
    Profil pro
    Inscrit en
    Février 2011
    Messages
    11
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2011
    Messages : 11
    Par défaut
    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 : 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
    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

  13. #13
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    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

Discussions similaires

  1. Afficher le résultat pas la formule (vba xls)
    Par jerem7w dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 01/12/2008, 14h31
  2. coller formules vba excel
    Par mapmip dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 14/08/2006, 16h00
  3. Réponses: 2
    Dernier message: 02/06/2006, 11h26
  4. [VBA-E] Récupérer résultat d'une requête
    Par ragnarök dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 05/04/2006, 16h21
  5. Réponses: 2
    Dernier message: 31/01/2006, 16h02

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo