Macro pour formule colonne avec exception cellules colorées

Bonjour,

Je me permets de solliciter votre aide, encore une fois, car j'ai une macro inscrite dans une feuille pour permettre l'exécution automatique d'une formule sur l'ensemble d'une colonne (gentiment fournie par un membre).

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B:D")) Is Nothing Then
         Dim L%: L = Target.Row
         If Range("B" & L) <> "" And Range("D" & L) <> "" Then
            Range("E" & L) = Range("B" & L) * Range("D" & L)
         End If
    End If
Fin:
End Sub

Je précise que je ne souhaite pas volontairement transformé mon tableau en format tableau.

Je suis réellement à la recherche d'une solution VBA/macro.

J'aimerais intégrer à ce code une ligne qui permette de ne pas appliquer la formule si les cellules sont colorées.

Pourriez-vous m'aider s'il vous plait?

Merci d'avance & très bonne soirée.

Bonjour,

Essayez ceci:

Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("B:D")) Is Nothing Then
             Dim L%: L = Target.Row
             If Range("B" & L) <> "" And Range("D" & L) <> "" And Target.Interior.ColorIndex = xlNone Then
                Range("E" & L) = Range("B" & L) * Range("D" & L)
             End If
        End If
Fin:
End Sub

Cdlt

Bonjour,

en rajoutant un test sur la couleur de fond (plutôt le ColorIndex) de la cellule sélectionnée :

...   
Dim L%: L = Target.Row 
If Not Intersect(Target, Range("B:D")) Is Nothing Then
    If Target.Interior.ColorIndex < 0 Then ' si le fond n'est pas coloré
         If Range("B" & L) <> "" And Range("D" & L) <> "" Then
            Range("E" & L) = Range("B" & L) * Range("D" & L)
         End If
    End If
End If
...

A+

Edit :Bonjour Arturo83

désolé pour la quasi redite

Bonjour Arturo, Bonjour Algoplus,

Merci beaucoup pour vos ajouts de code

La formule fonctionne très bien, un grand merci à tous les deux

En revanche, j'ai oublié de préciser, et je m'en excuse, que mon fichier allait être verrouillé sur la colonne amount.
Et une fois l'onglet verrouillé, la formule ne fonctionne plus... même en laissant B à D déverrouillées pour la saisie évidemment.

Merci encore pour votre aide & très belle journée à vous.

Bonjour,

Eh bien, utilisez l'enregistreur de macros, pour déverrouiller la colonne E, puis la verrouiller à nouveau. Récupérez le code et collez-le dans la macro existante.

La partie déverrouillage en début de macro et la partie verrouillage en fin de macro.

Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fin: If Target.Count > 1 Then Exit Sub

    'Partie déverrouillage de la colonne E

    If Not Intersect(Target, Range("B:D")) Is Nothing Then
         Dim L%: L = Target.Row
         If Range("B" & L) <> "" And Range("D" & L) <> "" And Target.Interior.ColorIndex = xlNone Then
            Range("E" & L) = Range("B" & L) * Range("D" & L)
         End If
    End If

    'partie verrouillage de la colonne E

Fin:
End Sub

A tester

Cdlt

Bonjour,

Merci Arturo pour votre message.

Je viens de tester avec l'enregistrement de la macro verrouillage-déverrouillage:

'Partie déverrouillage de la colonne E
   ActiveSheet.Unprotect

Dim L%: L = Target.Row 
If Not Intersect(Target, Range("B:D")) Is Nothing Then
    If Target.Interior.ColorIndex < 0 Then ' si le fond n'est pas coloré
         If Range("B" & L) <> "" And Range("D" & L) <> "" Then
            Range("E" & L) = Range("B" & L) * Range("D" & L)
         End If
    End If
End If

'Partie verrouillage de la colonne E
        ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowInsertingRows:=True, AllowFiltering _
        :=True

End Sub

Mais j'ai un souci: dès que je saisis un chiffre dans la colonne B ou D, un pop-up s'affiche me demandant le mot de passe de verrouillage car la feuille est verrouillée par mot de passe.

Je me suis mal exprimée dans mon dernier post: l'ensemble de la feuille sera verrouillée, et non juste une colonne (pour peu que cela soit possible).

Je suis désolée, je suis vraiment débutante en macro/VBA.
Merci encore pour votre aide!

J'ai finalement trouvé comment ajouter le mot de passe à la macro:

ActiveSheet.Unprotect "lemotdepasse"

ActiveSheet.Protect "lemotdepasse", mes conditions

C'est juste que c'est plutôt lent, mais cela fonctionne très bien sinon.

Edit: dernière question: je viens de me rendre compte que lorsque j'efface le contenu des cellules B & D, le montant total en E ne d'efface pas lui, normal?
Que dois-je ajouter pour que celui-ci s'update avec le changement de contenu en B& D?

Merci Forum

a priori :

         If Range("B" & L) <> "" And Range("D" & L) <> "" Then
            Range("E" & L) = Range("B" & L) * Range("D" & L)
         Else
            Range("E" & L) = ""
         End If

Bonne soirée

edit : finalement pas sûr :

si B et D sont vides => rien en E (donc OK)

mais si seul B ou seul D est vide => rien en E . Est ce le résultat attendu? ou bien faudrait-il avoir : 0 ??

Merci Algo Plus

J'ai ajouté ta ligne et j'ai compris comment remplacer rien par 0.
Après test, j'ai un dernier souci: si je supprime les contenus de B & D par cellule, parfait tout fonctionne, H est bien à 0.

En revanche, si je veux vider les colonnes B & D en sélectionnant plusieurs lignes, le montant en H ne s'efface pas.
Je ne comprends pas pourquoi...

En fait, je cherche une macro au fonctionnement identique à celui d'une formule excel de montant total (B*D):
- si B & D remplies = montant calculé
- si D vide = E est 0
- si B vide = E est 0
- si B & D vides = E est 0

Un grande merci!!

En revanche, si je veux vider les colonnes B & D en sélectionnant plusieurs lignes, le montant en H ne s'efface pas.

Sauf s'il a été modifié, le code ne permet pas de sélectionner plusieurs lignes :

If Target.Count > 1 Then Exit Sub

Le plus simple est peut-être de mettre directement une formule dans la colonne E

Merci beaucoup AlgoPlus, mais la ligne de code en plus ne change rien. Le montant en E reste/ne revient pas à 0, même si B & D sont effacées.

En effet, le plus simple aurait été de mettre une simple formule excel (ça je sais faire ), mais j'ai 2 grosses contraintes:

- je ne peux pas mettre ma feuille au format tableau

- je souhaite que lors d'ajout de lignes, les formules soient dupliquées automatiquement

Un dernier essai qui permet de sélectionner plusieurs cellules (pour les effacer ....) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim L%, i As Integer
L = Target.Row
If Not Intersect(Target, Range("B:D")) Is Nothing Then
    For i = 0 To Target.Rows.Count - 1
        If Range("A" & L + i).Interior.ColorIndex < 0 Then ' si le fond n'est pas coloré
            Range("E" & L + i).Value = Range("B" & L + i).Value * Range("D" & L + i).Value
        End If
    Next
End If
End Sub

Merci beaucoup pour ton aide AlgoPlus!