• Initiateur de la discussion Initiateur de la discussion marti018
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

M

marti018

Guest
bonjour le forum, bonjour tout le monde...
je vous écris car j'ai besoin d'aide...
je cherche à mettre en place dans un tableau une macro qui en fonction de deux conditions fait la somme de la cellule à droite de la cellule cible dans un total...
J'ai écris un bout de code mais je ne sais pas comment mettre bout à bout ces deux conditions..

voilà merci d'avance.....bravo pour ce super forum!!
 

Pièces jointes

le code

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Err_Worksheet_Change

Dim Coul_1 As Long
Dim Coul_2 As Long
Dim Coul_3 As Long
Dim DernièreColonne As Integer
facturation As Integer
TotalM As Range
TotalI As Range
TotalO As Range

Application.EnableEvents = False
Application.ScreenUpdating = False

DernièreColonne = Range("A10").End(xlToRight).Column
Range(Target.Row, DernièreColonne + 4) = TotalM
Range(Target.Row, ladernière + 5) = TotalI
Range(Target.Row, ladernière + 6) = TotalO

if target.value = "X" 'et si la couleur de la cellule facturation est
'colorindex = 37 then totalm.value = totalm.value + facturation.value
End If

if target.value = "X" 'et si la couleur de la cellule facturation est
'colorindex = 35 then totali.value = totalo.value + facturation.value
End If

if target.value = "X" 'et si la couleur de la cellule facturation est
'colorindex = 38 then totalo.value = totali.value + facturation.value

End If

End Sub
 
Re : deux conditions

j'ai completé le code mais celà ne marche pas....

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin

Dim Coul_1 As Long
Dim Coul_2 As Long
Dim Coul_3 As Long
Dim DernièreColonne As Integer
Dim facturation As Integer
Dim TotalM As Range
Dim TotalI As Range
Dim TotalO As Range

Application.EnableEvents = False
Application.ScreenUpdating = False

DernièreColonne = Range("A10").End(xlToRight).Column
Range(Target.Row, DernièreColonne + 4) = TotalM
Range(Target.Row, DernièreColonne + 5) = TotalI
Range(Target.Row, DernièreColonne + 6) = TotalO

If Target.Value = "X" And Target.ColorIndex = 37 Then TotalM.Value = TotalM.Value + facturation.Value
End If

If Target.Value = "X" And Target.ColorIndex = 35 Then TotalI.Value = TotalO.Value + facturation.Value
End If

If Target.Value = "X" And Target.ColorIndex = 38 Then TotalO.Value = TotalI.Value + facturation.Value
End If

Fin
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
 
Dernière modification par un modérateur:
Re : deux conditions

j'ai peur que mon code ne rentre en conflit avec un déjà présent sur ma feuille dont le rôle est de colorer des colonnes en fonction d'une saisie...un petit peu d'aide s'il vous plaît..........................😱 😱
 
Re : deux conditions

Bonjour,😀 😀
un tout petit peu d'aide serait la bienvenue.....je me contenterai même d'une piste...mon code est totalement à côté de la plaque ou peut etre qu'il ne faut changer quelques déclaration??
merci d'avance.... a+
Julien.
 
Re : deux conditions

peut être est-ce parce que je me suis mal expliqué...
ce que je cherche à produire avec cette macro:
dans ce tableau les colonnes sont groupées par 3 (heures effectuées, facturation et flash) le flash c'est une information que reçoit l'entreprise par son service comptabilité, il signifie que le montant facturé est bien soldé.
Les letttres M, I, O correspondent au trois types de main d'oeuvre employées par l'entreprie M = mensuelle, I = interimaire, O = ouvrière interne

mon objectif est de reporter dans un total M, total I et total O le total des sommes flashées ( c'est à dire que la case flash correspondante est barrées par un "X") pour ensuite pouvoir calculer la part respective du cout d'emploi de chaque type de main d'oeuvre..voilà

pour plus de renseignement n'hésitez pas à me demander....moi je continue de chercher une solution à mon probléme...

merci d'avance a++
Julien.
 
Dernière modification par un modérateur:
Re : deux conditions

bonjour marti


tu ne peux pas avoir deux fois le meme procedure change dans un module de feuille.

il va te falloir regrouper ces deux codes.

mais pour ceci il nous faudrait plus d'explication, avec un exemple chiffré.

dans ton code comment initialises-tu tes variables TotalM, etc....

tu les as déclarées en range, c'est des cellules ? si oui lesquelles ?

en somme en l'etat actuel de tes explications, on peut pas faire grand chose pour toi 🙂

au plaisir de te lire.

salut

ps perso : salut ptite olive.
 
Re : deux conditions

Au fait Hervé c'est peu être indiscret de ma part mais qui est petite olive? nous ne sommes que deux sur le fil.........à mon qu'il n'y ait des passsages secrets !!! !!!!!!!😱
 
Re : deux conditions

re marti

contrairement à ce que tu penses, nous ne sommes pas que deux sur ce fil, petite olive est l'ange de ce forum qui m'a envoyé un message pour que je regarde ton souci 🙂

en piece jointe ton fichier modifié.

il te reste à rendre dynamique tout ceci pour que le code s'adapte lors d'ajout de colonne.

j'ai repris tout ton code pour les couleurs.

salut
 

Pièces jointes

Re : deux conditions

je pense qu'il est possible de le faire par une boucle comme ceci

PHP:
Option Explicit
Dim bon As Boolean
        
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Coul_1 As Long
Dim Coul_2 As Long
Dim Coul_3 As Long
Dim Coul_4 As Long
Dim Coul_5 As Long
Dim ligne As Range
Dim totalM As Double
Dim totalO As Double
Dim totalI As Double
Dim couleur As Long
Dim c As Range
Dim DernièreColonne As Integer
Dim i As Integer

If bon = True Then
    bon = False
    Exit Sub
    
Else
    If Target.Row = 9 Then
        bon = True
        Target = UCase(Target(1))
        Select Case Target(1)
            Case "M"
                Coul_1 = 37     'titre
                Coul_2 = 5      ' G
                Coul_3 = 33     ' D
                Coul_4 = 37     ' colG
                Coul_5 = 34     'col D
            Case "O"
                Coul_1 = 4     'titre
                Coul_2 = 50      ' G
                Coul_3 = 35     ' D
                Coul_4 = 35     ' colG
                Coul_5 = 4     'col D
            Case "I"
                Coul_1 = 3     'titre
                Coul_2 = 3      ' G
                Coul_3 = 38     ' D
                Coul_4 = 38     ' colG
                Coul_5 = 3     'col D
            Case Else
                Coul_1 = -4142     'titre
                Coul_2 = -4142      ' G
                Coul_3 = -4142     ' D
                Coul_4 = -4142     ' colG
                Coul_5 = -4142     'col D
        End Select
        'Titre
        Cells(Target.Row - 3, Target.Column).Interior.ColorIndex = Coul_1
        Cells(Target.Row + 1, Target.Column).Interior.ColorIndex = Coul_2
        Cells(Target.Row + 1, Target.Column + 2).Interior.ColorIndex = Coul_3
        Range(Cells(11, Target.Column).Address & ":" & _
              Cells(62, Target.Column).Address).Interior.ColorIndex = Coul_4
        Range(Cells(11, Target.Column + 2).Address & ":" & _
              Cells(62, Target.Column + 2).Address).Interior.ColorIndex = Coul_5
    
        If Coul_5 = -4142 Then MsgBox ("Remise à blanc!")
    End If
End If

DernièreColonne = Range("A10").End(xlToRight).Column

For i = 1 To DernièreColonne

If Not Intersect(Target, Range("plage")) Is Nothing Then
    Set ligne = Range(Cells(Target.Row, "C"), Cells(Target.Row, DernièreColonne))
    For Each c In ligne
        couleur = c.Interior.ColorIndex
        If couleur = 3 Or couleur = 4 Or couleur = 34 Then
            If c = "X" Then
                Select Case Cells(9, c.Column - 2)
                    Case "M": totalM = totalM + c.Offset(0, -1)
                    Case "I": totalI = totalI + c.Offset(0, -1)
                    Case "O": totalO = totalO + c.Offset(0, -1)
                End Select
            End If
        End If
    Next c
    
    Cells(Target.Row, DernièreColonne + 4) = totalM
    Cells(Target.Row, DernièreColonne + 5) = totalI
    Cells(Target.Row, DernièreColonne + 6) = totalO
End If
Next i
End Sub

je crains que cela ne fonctionne pas car à chaque foi j'utilise une méthode qui semble - t'il n'est pas bonne...si encore une foi cela n'est pas bon j'aimerai juste que l'on me dise pourquoi......

voilà merciiiiiiii😉
 
Dernière modification par un modérateur:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
4
Affichages
227
Retour