Remplissage automatique selon critères

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'255
Appréciations reçues : 399
Inscrit le : 27 août 2012
Version d'Excel : O365 32 bits

Message par Jean-Eric » 28 décembre 2016, 11:54

Bonjour,
Une proposition à étudier et à adapter. ;;)
Cdlt.
Morgan2835.xlsm
(25.54 Kio) Téléchargé 17 fois
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
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
M
Morgan2835
Jeune membre
Jeune membre
Messages : 20
Inscrit le : 27 décembre 2016
Version d'Excel : 2010

Message par Morgan2835 » 28 décembre 2016, 13:38

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
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'255
Appréciations reçues : 399
Inscrit le : 27 août 2012
Version d'Excel : O365 32 bits

Message par Jean-Eric » 28 décembre 2016, 15:34

Re,
Voir fichier modifié en conséquence.
Quelle est la règle à appliquer pour la note maximale ?
Cdlt.
xlp - Morgan2835.xlsm
(28.54 Kio) Téléchargé 20 fois
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
M
Morgan2835
Jeune membre
Jeune membre
Messages : 20
Inscrit le : 27 décembre 2016
Version d'Excel : 2010

Message par Morgan2835 » 30 décembre 2016, 14:45

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 :D
' 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
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'255
Appréciations reçues : 399
Inscrit le : 27 août 2012
Version d'Excel : O365 32 bits

Message par Jean-Eric » 30 décembre 2016, 16:22

Bonjour,
Je ne comprends pas tout. :oops:
D'autant plus, que tes plages (nommées) n'existent pas.
Regarde le fichier et redis moi.
Cdlt.
xlp - Morgan2835 v1.xlsm
(30.42 Kio) Téléchargé 24 fois
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
M
Morgan2835
Jeune membre
Jeune membre
Messages : 20
Inscrit le : 27 décembre 2016
Version d'Excel : 2010

Message par Morgan2835 » 30 décembre 2016, 20:33

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
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'255
Appréciations reçues : 399
Inscrit le : 27 août 2012
Version d'Excel : O365 32 bits

Message par Jean-Eric » 30 décembre 2016, 21:35

RE,
Nous verrons donc mardi prochain. ;;)
Bonnes fêtes de fin d'années.
Cdlt.
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message