Remplissage automatique selon critères

Bonjour,

Je me permets de solliciter votre aide car je suis dans l'impasse.

Dans un souci de gain de temps, je souhaiterais automatiser une grille que je remplis plusieurs fois par jour.

Je m'explique :

Je dois mettre une note qui va de 0 à 3 (0, 1, 2, 3) selon un critère bien précis qui se trouve en colonne R.

Je vous ai extrait seulement une ligne normalement elle en comprend une soixantaine d'ou mon envie d'automatisation.

Une fois que je choisis la note à mettre, je colore donc la cellule en rouge, prenons pour exemple le fichier que je vous joins ci-dessous.

Exemple : Pour le critère "Aspect de l'environnement", je mets la note de 2, donc dans la cellule D5 j'applique une couleur rouge.

Je voudrais savoir s'il était possible de sélectionner les valeurs de ma grille mais seulement les valeurs donc les cellules sont colorées en rouge pour coller leur valeur dans la colonne K soit "Note calculée".

Je remercie par avance toute personne prenant le temps de lire voire même de répondre à mon sujet.

En vous souhaitant à toutes et a tous de bonne fêtes de fin d'année.

Cordialement,

Morgan2835

bonjour

avec des mises en forme conditionelles...

un essai convient-il

fred

Bonjour,

Est-ce qu'un double-clic sur la note souhaitée, qui te la colorierait en rouge et la copierait en K5, te conviendrait ?

Cordialement, Daniel

Bonjour à vous deux et merci,

Fred2406, j'ai essayé avec le fichier que tu m'as joins mais le problème est que je voudrais que cela fasse l'inverse de la mise en forme conditionnelles, c'est à dire que je colore les cellules et ensuite la valeur est directement coller dans la colonne K soit avec un double clic comme nous l'indique Dan42153 ou d'une autre manière.

Dan42153, est-ce possible lors d'un double clic de : Colorer la cellule ciblée et la copie de la valeur dans la colonne K ?

Si oui, je pense que cela soit un bonne solution.

Cordialement,

Morgan2835

Tout à fait possible ! Je regarde ça dans la journée... Cordialement, Daniel

Super Dan42153 merci tu es un chef

Cordialement,

Morgan2835

Bonjour

autre possibilité sans macro, et qui correspondrais a la demande, installer le pack de fonctions supplémentaires disponible ici :

https://www.excel-pratique.com/fr/fonctions-complementaires.php

et utilisé l'une des deux fonctions suivantes en colonne K :

SOMME_SI_COLORE Effectue la SOMME des cellules dont le fond est coloré, en ignorant les valeurs non numériques (les cellules à fond blanc ou sans fond ne sont pas comptabilisées, ne fonctionne pas avec les cellules colorées par MFC).

SOMME_SI_COULEUR Effectue la SOMME des cellules dont le fond est de la couleur indiquée (en ignorant les valeurs non numériques, ne fonctionne pas avec les cellules colorées par MFC).

Fred

Bonjour et merci fred2406,

Le soucis est que mon fichier est sur un réseau et que je ne suis pas le seul à y avoir accès.

Faut-il installer le pack de fonctions supplémentaires sur tous les postes utilisant ce fichier ?

Cordialement,

Morgan2835

je crois que oui... les fonctions ne naviguent pas avec le fichier....

voir ici pour l'installation si cela peut servir quand même car ce détail de fonctionnement en réseau n'était pas précisé....

https://www.excel-pratique.com/fr/fonctions-complementaires/installation-macro-complementaire.php

fred

Merci Fred,

Je vais en effet utiliser cette fonction en attendant de voir si Dan42153 arrive à trouver quelque chose qui n'a pas besoin d'instalation multiple.

Cordialement,

Morgan2835

Bonjour,

Une proposition à étudier et à adapter.

Cdlt.

Option Explicit
' module de feuille
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim x As Double, y As Double
    If Not Intersect(Target, Range("B:E")) Is Nothing And Target.Count = 1 Then
        Cancel = True
        x = Choose(Target.Column, 0, 0, 1, 2, 3)
        y = Cells(Target.Row, 10)
        With Me.Cells(Target.Row, 2).Resize(1, 4).Font
            .Bold = False
            .ColorIndex = xlAutomatic
        End With
        With Target.Font
            .Bold = True
            .Color = -16776961
        End With
        Me.Cells(Target.Row, 11) = x * y
    End If
End Sub

Option Explicit
Option Private Module
' Module standard
Public Sub RAZ()
Dim n As Long
    With ActiveSheet
        n = .Cells(.Rows.Count, 2).End(xlUp).Row
        With .Cells(5, 2).Resize(n - 4, 5)
            .Font.Bold = False
            .Font.ColorIndex = xlAutomatic
        End With
        .Cells(5, 10).Resize(n - 4, 2).ClearContents
    End With
End Sub

Bonjour Jean-Eric et merci,

C'est exactement ce que je souhaitais trouver, je n'avait même pas parler de mon soucis de coéfficient mais tu en tenu compte comme il fallait, j'ai juste un soucis c'est qu'il n'y a pas toujours de coéfficient à appliquer.

Comment pourrais-je faire pour que lorsque la cellule coef est vide cela prenne par défaut 1 ?

Je te remercie énormément

Cordialement,

Morgan2835

Re,

Voir fichier modifié en conséquence.

Quelle est la règle à appliquer pour la note maximale ?

Cdlt.

Bonjour Jean-Eric,

Je te remercie pour le fichier modifié, j'ai modifié 2/3 trucs sur le code que tu m'as transmi.

Concernant la note maximal, je n'est pas besoin d'y appliqué une règle.

Je suis débutant voir même plus que débutant, mais ce que je voulais rajouter fonctionne.

Je te laisse jeter un coup d'oeil si tu as le temps

' module de grille d'insalubrité
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As range, Cancel As Boolean)
Dim x As Double, y As Double
    If Not Intersect(Target, range("B:E")) Is Nothing And Target.Count = 1 Then
        Cancel = True
        x = Choose(Target.Column, 0, 0, 1, 2, 3)
        y = IIf(IsEmpty(Me.Cells(Target.Row, 10)), 1, x * Me.Cells(Target.Row, 10))

        With Me.Cells(Target.Row, 2).Resize(1, 4).Font
            .Bold = False
            .ColorIndex = xlAutomatic
            .Strikethrough = False
        End With

        With Me.Cells(Target.Row, 2).Resize(1, 4).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 16777215
        End With

        With Target.Font
            .Bold = True
            .Color = -16776961
            .Strikethrough = False
        End With

        With Target.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 9868950
        End With

        Me.Cells(Target.Row, 11) = y
    End If
End Sub

&

' Module standard
Public Sub RAZ()
Dim n As Long
    If MsgBox("Etes-vous certain de vouloir réinitialiser le contenu des cellules ?", vbYesNo, "Demande de confirmation") = vbYes Then
            range("ma_plage").Value = 0
            range("mes_commentaires").ClearContents
            MsgBox "Le contenu des cellules a été réinitialisé !"
        With ActiveSheet
        n = .Cells(.Rows.Count, 2).End(xlUp).Row
            With .Cells(5, 2).Resize(n - 4, 5)
            .Font.Bold = False
            .Font.ColorIndex = xlAutomatic
            .Font.Strikethrough = False
            .Interior.Pattern = xlSolid
            .Interior.PatternColorIndex = xlAutomatic
            .Interior.Color = 16777215
            End With
        End With
    End If
End Sub

Cordialement,

Morgan2835

Bonjour,

Je ne comprends pas tout.

D'autant plus, que tes plages (nommées) n'existent pas.

Regarde le fichier et redis moi.

Cdlt.

Alors, Oui si j'oublie de te dire que j'ai migré ton code vers mon fichier source.

Si cela t'intéresse je pourrais te transmettre mon fichier mardi

Cordialement,

Morgan2835

RE,

Nous verrons donc mardi prochain.

Bonnes fêtes de fin d'années.

Cdlt.