Cumul de l'index des choix de plusieurs listes déroulantes en VBA

[Victor21]

Bonjour à tous.

Un ami pompier me demande de modifier une macro dans le fichier joint, et les habitués connaissent mon niveau en VBA .

12 colonnes (D à O), présence aux formations mensuelles.
On choisit la durée de présence dans la liste déroulante : 1;2;3; Excusé; Absent (1, 2 ou 3 sont des heures.)
La macro affiche dans la cellule concernée le montant de la rémunération en fonction d'un barême.

La demande de modification porte sur le cumul, en colonne P des nombres choisis dans les listes déroulantes (Durée totale aux formations).

L'idéal serait qu'en cas de modification à cause d'une erreur dans le choix, seul e la dernière saisie soit prise en compte.


Je sais pouvoir compter sur vous pour un code aussi évident (après coup ) et d'avance, je vous remercie de vos propositions

 

[Guest]

Re : Cumul de l'index des choix de plusieurs listes déroulantes en VBA

Bonjour l'ami

Voici une solution par fonction vba personnalisée. =CumulValeursOrigines($D3:$O3;$A3)

Il y aurait plus simple si les coefficients étaient dans des Noms, éventuellement cachés où en Constantes Publiques dans un module général, où dans des cellules Fixes sur une feuille éventuellement cachée.

Là j'ai simplement repris leur calcul à l'envers.

Le premier paramètre de la fonction est la plage en ligne à vérifier , le second argument est la cellule qui contient le Grade. J'ai choisis ainsi pour qu'il ne soit pas recalculé à chaque boucle.


A++++ l'ami

[EDIT] en mettant les valeurs de grade en noms (cachés ou non) où sur une feuille "varibles" (cachée ou non), le calcul pourrait se faire par les fonctions excel. Et ça tu saurait le faire...arf

 

[Si...]

Re : Cumul de l'index des choix de plusieurs listes déroulantes en VBA

salut

à tester, avec la macro déjà présente mais modifiée.

 

[Victor21]

Re : Cumul de l'index des choix de plusieurs listes déroulantes en VBA

Bonjour, Hasco.

Merci pour ta fonction qui fonctionne parfaitement, après les quelques tests que j'ai effectués

Je vais en profiter pour la disséquer, car je ne suis pas du tout à l'aise avec les fonctions personnalisées

 

[Guest]

Re : Cumul de l'index des choix de plusieurs listes déroulantes en VBA

Re Patrick,

As-tu vu le message de Si... qui a choisit une autre méthode possible.

Quant à moi, je n'ai pas voulu trop déformer ce qu'avait fait ton ami pompier, pour qu'il puisse s'y retrouver.

A+

 

[Victor21]

Re : Cumul de l'index des choix de plusieurs listes déroulantes en VBA

Bonjour, Si...

Merci pour ton code.

Ma connaissance de VBA n'est pas suffisante pour en comprendre les subtilités (Dim S(40, 12) As Currency ?), ni pour le modifier

Je rencontre un pb lorsqu'après avoir choisi par exemple "1" en colonne D, je modifie la colonne D "Excusé" : le 1 subsiste...

 

[Victor21]

Re : Cumul de l'index des choix de plusieurs listes déroulantes en VBA

Bonjour à tous les deux

Pour ma part, j'en suis là :

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Grade As String                                             ' Grade de l'agent
Dim Off As Currency                                             ' Officiers
Dim Sof As Currency                                             ' Sous/Officiers
Dim Cap As Currency                                             ' Caporaux
Dim Sap As Currency                                             ' Sapeurs
' Initialisation des variables et constantes
Grade = Range("A" & Target.Row).Value                           ' Valeur en colonne A
Off = 11.43                                                     ' Rémunération horaire des Officiers
Sof = 9.21                                                      ' Rémunération horaire des Sous-Officiers
Cap = 8.16                                                      ' Rémunération horaire des Caporaux
Sap = 7.6                                                       ' Rémunération horaire des Sapeurs

' Permet de n'agir que sur la zone "Exercices"
If Intersect(Target, Range("D3:O44")) Is Nothing Or Target.Count > 1 Then Exit Sub
' Empècher les évènements, en cas de changement
Application.EnableEvents = False
 ' Réinitialisation du total
Range("P" & Target.Row).Value = 0
' En fonction du choix dans la liste déroulante (1;2;3; Excusé; Absent)
Select Case Target.Value
' Calcul du montant en fonction de la durée de présence et du grade
Case 1 To 3
    If Grade = "LTN" Or Grade = "CNE" _
       Then Target.Value = Round(Target.Value * Off / 2, 2)
    Range("P" & Target.Row).Value = Round(Application.Sum(Range("D" & Target.Row & ":O" & Target.Row)) * 2 / Off, 0)
    If Grade = "ADC" Or Grade = "ADJ" Or Grade = "SCH" Or Grade = "SGT" _
       Then Target.Value = Round(Target.Value * Sof / 2, 2)
    Range("P" & Target.Row).Value = Round(Application.Sum(Range("D" & Target.Row & ":O" & Target.Row)) * 2 / Sof, 0)
    If Grade = "CCH" Or Grade = "CPL" _
       Then Target.Value = Round(Target.Value * Cap / 2, 2)
    Range("P" & Target.Row).Value = Round(Application.Sum(Range("D" & Target.Row & ":O" & Target.Row)) * 2 / Cap, 0)
    If Grade = "SAP" Or Grade = "1CL" _
       Then Target.Value = Round(Target.Value * Sap / 2, 2)
    Range("P" & Target.Row).Value = Round(Application.Sum(Range("D" & Target.Row & ":O" & Target.Row)) * 2 / Sap, 0)
' En cas d'absence
Case Else
    Target.Value = Target.Value
End Select
' Activer les évènements
Application.EnableEvents = True
End Sub

Mais la formule renvoie parfois des erreurs que je n'explique pas (peut-être round ?)

 

[Guest]

Re : Cumul de l'index des choix de plusieurs listes déroulantes en VBA

Re Patrick

Application.RoundUp(0.4888,0) donnera 1 alors que Round(0.4888,0) donne 0

A+

 

[Victor21]

Re : Cumul de l'index des choix de plusieurs listes déroulantes en VBA

Re, lézamis

Pour me coucher moins bête ce soir, j'aimerais quand même bien comprendre pourquoi :
quand Target est en H22, et que Off= 11.43

Range("P" & Target.Row).Value = Round(Application.Sum(Range("D" & Target.Row & ":O" & Target.Row)) * 2 / Off, 0)

n'est pas toujours égal à :

P22=SOMME(D22:O22)*2/11.43

(mon séparateur numérique est bien le point)

 

[Victor21]

Re : Cumul de l'index des choix de plusieurs listes déroulantes en VBA

Merci, Hasco, je regarde ça

Pas simple...

Re Patrick

Application.RoundUp(0.4888,0) donnera 1 alors que Round(0.4888,0) donne 0

A+

 

[Si...]

Re : Cumul de l'index des choix de plusieurs listes déroulantes en VBA

salut

l'utilisation du tableau était mal programmée donc suppression du fichier dans la réponse précédente.
On peut aussi, pour simplifier, stocker les valeurs saisies dans des colonnes.
Voici 2 exemples, le second avec un contrôle Userform appelé par double clic.

Remarque : ici, le format de cellule amène à un arrondi !

 

[Victor21]

Re : Cumul de l'index des choix de plusieurs listes déroulantes en VBA

Bonjour, Si...

Je te remercie pour tes efforts, et les deux solutions poposées renvoient le résultat désiré. Bravo à toi

Sauf que je suis un ch...nt : je ne souhaite pas chambouler l'existant, je ne souhaite pas de colonne intermédiaire, je ne souhaite pas de formule dans ma feuille : Une simple correction de la ligne au #9 ou une solution pour obtenir ce résultat me conviendrait.

Mais y'a pas le feu

PS : ce n'est pas un caprice, c'est juste pour conserver la logique et garantir la maintenance de l"application qui comporte d'autres feuilles et d'autres macros.

 

[Guest]

Re : Cumul de l'index des choix de plusieurs listes déroulantes en VBA

Bonjour Patrick,

Ce sont les instructions IF sans End IF qui posent problème. Ecrit comme cela, ça va mieux:

       If Grade = "LTN" Or Grade = "CNE" Then
                Target.Value = Round(Target.Value * Off / 2, 2)
                Range("P" & Target.Row).Value = Round(Application.Sum(Range("D" & Target.Row & ":O" & Target.Row)) * 2 / Off, 0)
            ElseIf Grade = "ADC" Or Grade = "ADJ" Or Grade = "SCH" Or Grade = "SGT" Then
                Target.Value = Round(Target.Value * Sof / 2, 2)
                Range("P" & Target.Row).Value = Round(Application.Sum(Range("D" & Target.Row & ":O" & Target.Row)) * 2 / Sof, 0)
            ElseIf Grade = "CCH" Or Grade = "CPL" Then
                Target.Value = Round(Target.Value * Cap / 2, 2)
                Range("P" & Target.Row).Value = Round(Application.Sum(Range("D" & Target.Row & ":O" & Target.Row)) * 2 / Cap, 0)
            ElseIf Grade = "SAP" Or Grade = "1CL" Then
                Target.Value = Round(Target.Value * Sap / 2, 2)
                Range("P" & Target.Row).Value = Round(Application.Sum(Range("D" & Target.Row & ":O" & Target.Row)) * 2 / Sap, 0)
            End If

Pour voir la différence, mets un point d'arrêt (F9) sur la ligne du premier IF et lorsque la macro s'arrête, fait du pas à pas (F8) ligne par ligne. Tu verras que plusieurs lignes Range("P" & Target.Row .... sont exéctuée pour un même choix, ce qui est normal.

Des if...End if successifs sont tous évalués à chaque appel de la procédure
Avec if ... ElseIF...End if dès qu'une condition est vérifiée et les actions idoines executées, vb saute au END IF de fin

If Condition Then Action 'exécuté si condition vérifiée
Range("P" & ... 'toujours exécutée puisque hors condition



A+

P.S. plus un code est 'aéré' plus il est facile à déboguer.

 

[Victor21]

Re : Cumul de l'index des choix de plusieurs listes déroulantes en VBA

Bonjour, Hasco

Non non, je n'abandonne pas : je bidouille...
Ta correction fonctionne pour le choix des valeurs numériques : (1;2;3)

Case 1 To 3
    If Grade = "LTN" Or Grade = "CNE" Then
        Target.Value = Round(Target.Value * Off / 2, 2)
        Range("P" & Target.Row).Value = Round(Application.Sum(Range("D" & Target.Row & ":O" & Target.Row)) * 2 / Off, 0)

    ElseIf Grade = "ADC" Or Grade = "ADJ" Or Grade = "SCH" Or Grade = "SGT" Then
        Target.Value = Round(Target.Value * Sof / 2, 2)
        Range("P" & Target.Row).Value = Round(Application.Sum(Range("D" & Target.Row & ":O" & Target.Row)) * 2 / Sof, 0)

    ElseIf Grade = "CCH" Or Grade = "CPL" Then
        Target.Value = Round(Target.Value * Cap / 2, 2)
        Range("P" & Target.Row).Value = Round(Application.Sum(Range("D" & Target.Row & ":O" & Target.Row)) * 2 / Cap, 0)

    ElseIf Grade = "SAP" Or Grade = "1CL" Then
        Target.Value = Round(Target.Value * Sap / 2, 2)
        Range("P" & Target.Row).Value = Round(Application.Sum(Range("D" & Target.Row & ":O" & Target.Row)) * 2 / Sap, 0)
        
    End If
' En cas d'absence
Case Else

   Target.Value = Target.Value
    Range("P" & Target.Row).Value = Range("P" & Target.Row).Value - 1

End Select

Reste à modifier le calcul de P lors de la modification d'un choix (remplacer un choix numérique par un choix alpha : actuellement j'ôte 1).
Je vais devoir me résoudre à un nouveau select case pour soustraire les heures en fonction du montant et du grade Mais je devrais pouvoir m'en sortir.

En tous cas, merci beaucoup pour l'aide que tu m'as apportée.

 

[Guest]

Re : Cumul de l'index des choix de plusieurs listes déroulantes en VBA

Re, Patrick,

Pour simplifier un peu l'écriture sans toutefois trop s'éloigner de ce qu'a fait ton pote pompier:
Rajouter en début de macro une variable Currency (nommée ci-dessous 'Rémunération') qui recevra le facteur multiplicateur, seul élément qui change.

Case 1 To 3
    'Choix du multiplicateur en fonction du grade
    Select Case Grade
        Case "LTN", "CNE"
            Rémunération = off
        Case "ADC", "ADJ", "SCH", "SGT"
            Rémunération = Sof
        Case "CCH", "CPL"
            Rémunération = Cap
        Case "SAP", "1CL"
            Rémunération = SAP
    End Select
    'Placer la valeur dans la cellule Target
    Target.Value = Round(Target.Value * Rémunération / 2, 2)
    Range("P" & Target.Row).Value = Round(Application.Sum(Range("D" & Target.Row & ":O" & Target.Row)) * 2 / Rémunération, 0)
    
    ' En cas d'absence
Case Else
   ' Target.Value = Target.Value 'inutile cette ligne
   'Par contre ci-dessous je remettrais la formule de calcul 
   'au cas ou quelqu'un aurait modifier involontairement(ou non) le nombre déjà présent dans la cellule
    Range("P" & Target.Row).Value = Range("P" & Target.Row).Value - 1
End Select

Ce sera plus simple à corriger.

A+