Formules pondération dans VBA

Bonjour à tous,

Je tente d'inclure une formule de pondération suite au choix d'une note (par un double clic) dans un code vba.

Pour exemple, je souhaite obtenir le résultat suivant :

ponderation notes

Comme on peut le constater, les pondérations sont différentes selon l'importance de tel ou tel critère, mais la note est différente aussi, ce qui va donner un résultat en % différent évidemment.

C'était un ancien fichier d'évaluation et la formule est simple puisque fixe et sans VBA dedans.

Cependant dans le fichier joint je n'arrive pas à inclure la formule qui prendrait à la fois en compte le choix par double clic de la note (1 à 5) et la pondération de la colonne différent pour chaque ligne.

Ça me met le résultat en pourcentage mais seulement en fonction de la note. Il me manque donc la partie pondération comme vous pouvez le constater ci-dessous.

ponderation notes2

Je souhaiterai donc faire afficher dans les colonnes J (colonnes de résultats) les bons résultats avec la pondération.

Je connais la formule, mais pas comment l'inclure dans le code. Je débute en vba alors c'est un peu balbutiant on va dire...

ponderation notes3

Quelqu'un peut m'aider?

Voici le fichier en question

10test-macro-new.xlsm (60.23 Ko)

(mot de passe : laurent)

Merci d'avance et bonne journée

Laurent

Bonjour,

Hum... Il ne t'aura pas échappé qu'ici c'est un forum Excel/VBA : ce jpg est bien mistérieux.

Les explications n'apportent rien et le code non plus.

Il serait intéressant que tu nous mettent en colonne J quelques résultats (calculés avec formule) pour qu'on traduise ça en VBA.

Par que si toi tu connait la formule ... Pour moi ces pondérations sont nébuleuses :!

A+

Bonjour,

Commence peut-être en modifient ainsi :

Range("J" & .Row).Value = .Address

Mais le résultat est la plage de cellules fusionnées !...

Cdlt.

Bonjour,

Hum... Il ne t'aura pas échappé qu'ici c'est un forum Excel/VBA : ce jpg est bien mistérieux.

Les explications n'apportent rien et le code non plus.

Il serait intéressant que tu nous mettent en colonne J quelques résultats (calculés avec formule) pour qu'on traduise ça en VBA.

Par que si toi tu connait la formule ... Pour moi ces pondérations sont nébuleuses :!

A+

Bonjour galopin01

Désolé pour le jpg du code, je ne savais pas comment l'intégrer dans le message à part le copier (j'aurais peut-être du faire ça d'ailleurs... ).

Je ne sais pas comment expliquer plus simplement :

La formule est : =(cellule de la note choisie*cellule de la pondération)/nombre de notes au choix

Comme dans l'exemple ci-dessous

form

Pour transposer cette formule simple à mon fichier de travail ça donne ça :

[*]La cellule de la note choisie : celle où l'on double clic pour choisir la note (entre 1 et 5)

[*]La cellule de pondération : celle dans la colonne D

[*]Le nombre de note : ici 5

C'est à dire ça :

form2

Mais le fichier ne me laisse pas enregistrer la formule d'une part, et d'autre part je n'arrive pas à faire fonctionner la formule dans le code

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Set Notes = Range("E14:I50") ' plage où les notes existent
    CouleurVerte = vbGreen
    CouleurBlanche = vbWhite
    If Not Application.Intersect(Notes, Target) Is Nothing Then
        Cancel = True
        ActiveSheet.Unprotect Password:="laurent"
        With Target
            If .Interior.Color = CouleurBlanche Then
                Cells(.Row, 5).Resize(Target.Rows.Count, 5).Interior.Color = CouleurBlanche
                .Interior.Color = CouleurVerte
                Range("J" & .Row).Value = "=" & .Address
            Else
                .Interior.Color = CouleurBlanche
                Range("J" & .Row).Value = ""
            End If
        End With
        ActiveSheet.Protect Password:="laurent", DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
        Range("C6").Select
    End If
End Sub

Je remets ici le fichier si tu veux jouer dedans

Merci d'avance

si tu veux jouer dedans...

Les cellules fusionnées et VBA font rarement bon ménage :

Ce genre de sport est un passe temps dont les utilisateurs avisés de VBA se passent généralement !

Ta macro modifiée :

Dim i, ii
If Target.Columns.Count = 1 Then
i = 10 - Target.Column
ii = Target.Column - 4
    Set Notes = Range("E14:I50") ' plage où les notes existent
    CouleurVerte = vbGreen
    CouleurBlanche = vbWhite
    If Not Application.Intersect(Notes, Target) Is Nothing Then
         Cancel = True
         ActiveSheet.Protect Password:="laurent", UserInterfaceOnly:=True
         With Target
            If .Interior.Color = CouleurBlanche Then
                Cells(.Row, 5).Resize(Target.Rows.Count, 5).Interior.Color = CouleurBlanche
                .Interior.Color = CouleurVerte
               Target.Offset(, i).Formula = _
"= " & Range(Split(Target.Offset(, -ii).Address, ":")(0)).Value & "* " & Target.Column - 4 & " /5"
            Else
                .Interior.Color = CouleurBlanche
                Range("J" & .Row).Value = ""
            End If
        End With
        Range("C6").Select
    End If
End If
End Sub

Nota : Je n'ai pas compris de quel chapeau tu tires ton :

Le nombre de note : ici 5

...alors j'ai pris comme toi : 5

A+

4laurentzic-vg.xlsm (59.34 Ko)

Bonjour galopin01

Nota : Je n'ai pas compris de quel chapeau tu tires ton :

Le nombre de note : ici 5

...alors j'ai pris comme toi : 5

C'est le nombre de choix, donc c'est le dénominateur de la formule

J'ai regardé ton code et je l'ai collé dans mon excel, tu avais enlevé le double clic pour la sélection donc ça ne fonctionnait plus,

alors j'ai remis la commande du double clic en début avec la première borne

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Je récupère donc le double clic avec ça.

Mais il me sort le débogueur car la syntaxe de la formule pose problème apparemment, j'ai cherché pourquoi mais ça me semble bon pourtant :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim i, ii
If Target.Columns.Count = 1 Then
i = 10 - Target.Column
ii = Target.Column - 4
Set Notes = Range("E14:I50") ' plage où les notes existent
    CouleurVerte = vbGreen
    CouleurBlanche = vbWhite
    If Not Application.Intersect(Notes, Target) Is Nothing Then
        Cancel = True
        ActiveSheet.Unprotect Password:="laurent"
        With Target
            If .Interior.Color = CouleurBlanche Then
                Cells(.Row, 5).Resize(Target.Rows.Count, 5).Interior.Color = CouleurBlanche
                .Interior.Color = CouleurVerte
                Target.Offset(, i).Formula = _
                "= " & Range(Split(Target.Offset(, -ii).Address, ":")(0)).Value & "* " & Target.Column - 4 & " /5"
            Else
                .Interior.Color = CouleurBlanche
                Range("J" & .Row).Value = ""
            End If
        End With
        ActiveSheet.Protect Password:="laurent", DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
        Range("C6").Select
    End If
    End If
End Sub

En fait il ne me donne pas de résultat du tout à cause du débogueur

Les cellules fusionnées et VBA font rarement bon ménage :

Ce genre de sport est un passe temps dont les utilisateurs avisés de VBA se passent généralement !

J'ai suivi ton conseil avisé et j'ai opté pour une mise en page plus simple sans cellule fusionnée pour les formules et cellules à cliquer.

Cela donne donc ceci en fichier :

Qu'en penses-tu?

Vu que j'ai supprimé les cellules fusionnées, cela change-t-il ta formule dans la macro?

Merci d'avance et bonne journée.

Sorry, je n'ai pas fait attention que cette ligne avait sauté avec le Copier/Coller.

Il fallait tester avec le fichier que je t'ai joint : Je n'ai pas d'erreur !

Comme tu n'indiques aucun détail sur ce que dit le débogueur et la ligne surlignée, je ne peux que supputer... que tu as semé une coquille...

Bien sur que ça change tout, s'il n'y a pas de cellules fusionnées mais je ne peux pas m'en occuper pour le moment.

Ça devient d'une simplicité enfantine, je suppose que quelqu'un t'aura pondu ça quand je serai revenu...

A+

Il fallait tester avec le fichier que je t'ai joint

Justement j'ai testé mais il ne me sélectionnait pas les cellules (à cause du double clic peut-être je pense). donc c'est pour ça que j'ai remis le double clic et c'est à ce moment que ça a commencé à foirer

Comme tu n'indiques aucun détail sur ce que dit le débogueur et la ligne surlignée, je ne peux que supputer... que tu as semé une coquille...

Oui désolé ce n'était pas clair, il s'agissait de ce bout de code que le débog me surlignait :

Target.Offset(, i).Formula = _
                "= " & Range(Split(Target.Offset(, -ii).Address, ":")(0)).Value & "* " & Target.Column - 4 & " /5"

Bien sur que ça change tout, s'il n'y a pas de cellules fusionnées mais je ne peux pas m'en occuper pour le moment.

Ça devient d'une simplicité enfantine, je suppose que quelqu'un t'aura pondu ça quand je serai revenu...

J'imagine que oui ça devient plus simple... je vais tester de mon côté mais si quelqu'un peut me mettre sur la voie.. et je peux attendre un peu aussi, ce n'est pas une question de vie ou de mort, enfin pas encore

Je te donne la macro modifiée :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim i, ii
If Target.Columns.Count = 1 Then
i = Target.Row
ii = Target.Value
Set Notes = Range("E14:I28") ' plage où les notes existent
    CouleurVerte = vbGreen
    CouleurBlanche = vbWhite
    If Not Application.Intersect(Notes, Target) Is Nothing Then
        Cancel = True
        ActiveSheet.Protect Password:="laurent", UserInterfaceOnly:=True
        With Target
            If .Interior.Color = CouleurBlanche Then
                Range("E" & i & ":I" & i).Interior.Color = CouleurBlanche
                .Interior.Color = CouleurVerte
                Range("J" & i).Formula = "= " & ii & "*" & " D" & i & " /5"
            Else
                .Interior.Color = CouleurBlanche
                Range("J" & i).Value = ""
            End If
        End With
        Range("C6").Select
    End If
    End If
End Sub

Remarque 1 : Si tu utilises "UserInterfaceOnly:=True" c'est comme ça que ça s'utilise : pas besoin de déprotéger ça évite de laisser ta feuille dans les courant d'air s'il y a le feu...

Remarque 2 : Si on se trompe et qu'on fait un double clic sur 2, et qu'ensuite on se ravise YAKA cliquer à coté pour que le 2 s'efface. On ne recliquera sur le 2 que si on veut laisser cette ligne vide...

Remarque 3 : C'est un peu idiot d'utiliser VBA pour écrire une formule...

Il y a avantage à afficher le résultat directement... Dans ce cas on supprimera cette ligne :

                Range("J" & i).Formula = "= " & ii & "*" & " D" & i & " /5"

et on la remplacera par cette autre :

                Range("J" & i) = ii * Range("D" & i) / 5

A+

Oh wow ça fonctionne impec!

Et en effet c'est bien plus simple avec des cellules uniques et non fusionnées

Merci pour l'aide! J'apprends beaucoup en même temps .

Merci encore et bonne journée

Rechercher des sujets similaires à "formules ponderation vba"