Formules pondération dans VBA
- Messages
- 101
- Excel
- 2019 fr
- Inscrit
- 28/05/2016
- Emploi
- Technicien en formation - Formateur
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 :
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.
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...
Quelqu'un peut m'aider?
Voici le fichier en question
(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.
- Messages
- 101
- Excel
- 2019 fr
- Inscrit
- 28/05/2016
- Emploi
- Technicien en formation - Formateur
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
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 :
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 :
...alors j'ai pris comme toi : 5Le nombre de note : ici 5
A+
- Messages
- 101
- Excel
- 2019 fr
- Inscrit
- 28/05/2016
- Emploi
- Technicien en formation - Formateur
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é
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+
- Messages
- 101
- Excel
- 2019 fr
- Inscrit
- 28/05/2016
- Emploi
- Technicien en formation - Formateur
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+
- Messages
- 101
- Excel
- 2019 fr
- Inscrit
- 28/05/2016
- Emploi
- Technicien en formation - Formateur
Oh wow
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