Double macro worksheet change sur une même feuille

Bonjour,

Il y a quelques jours j'ai obtenu une macro via ce forum dont je suis très content mais j'aimerais quelle fasse la même chose sur la même feuille mais sur un autre groupe de cellule. Voici ce que j'ai :

Private Sub Worksheet_change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

If Intersect(Target, Range("D3:G3")) Is Nothing Then Exit Sub

If Application.CountA(Range("D3:G3")) = 4 Then Call Changement_etape1

ElseIf Intersect(Target, groupe de cellule) Is Nothing Then Exit Sub

If Application.CountA(groupe de cellule)) = 3 Then Call Changement_etape2

End Sub

Sachant que mon "groupe de cellule " =union(range("R9":"T9"),range("V9":"X9"),range("Z9":"AB9"),range("AD9":"AF9"),range("AH9":"AJ9"),

La macro consiste à appeler une autre macro si toutes les cellules sont non vides (groupe de cellule) et se déclenche dès que la dernière cellule est modifiée.

J'ai vraiment du mal à comprendre les macro événementiel, votre aide m'est précieuse, en vous remerciant par avance.

Bonjour quiquequoidontou,

Voici un code à essayer:

Private Sub Worksheet_change(ByVal Target As Range)
    Dim ctl As Boolean
    Dim lst
    Dim cmp&, cmp1&
    Dim i, c

        'Array qui contient toutes les zones à scruter
        lst = Array("R9:T9", "V9:X9", "Z9:AB9", "AD9:AF9", "AH9:AJ9")
        cmp = 0: cmp1 = 0

        'Contrôle des zones
        For i = LBound(lst) To UBound(lst)
            Set plg = Application.Union(plg, Range(lst(i)))
            For Each c In plg
                If c <> "" Then cmp = cmp + 1
                cmp1 = cmp1 = 0
            Nect c
        Next i

        If cmp = cmp1 Then ctl = True

    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("D3:G3")) Is Nothing Then Exit Sub
    If Application.CountA(Range("D3:G3")) = 4 Then Call Changement_etape1
    ElseIf ctl = True Then Call Changement_etape2

End Sub
 

Merci Florian pour ta contribution néanmoins il semble avoir des bugs, j'ai essayé de le débugger

1/ En définissant plg dans les variables en haut

2/ Nect c --> en next c

3/ Dernière ligne le il y a else sans if me dit excel

Mais malgré mes modifications ca ne fonctionne pas.

Effectivement quelques oublis et quelques erreurs de frappe, voici le code modifié:

Private Sub Worksheet_change(ByVal Target As Range)
    Dim ctl As Boolean
    Dim lst, Plg As Range
    Dim cmp&, cmp1&
    Dim i, c

        'Array qui contient toutes les zones à scruter
        lst = Array("V9:X9", "Z9:AB9", "AD9:AF9", "AH9:AJ9")
        cmp = 0: cmp1 = 0

        Set Plg = Range("R9:T9")
        'Contrôle des zones
        For i = LBound(lst) To UBound(lst)
            Set Plg = Application.Union(Plg, Range(lst(i)))
        Next i

        For Each c In Plg
            If c <> "" Then cmp = cmp + 1
            cmp1 = cmp1 +1
        Next c

        If cmp = cmp1 Then ctl = True

    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("D3:G3")) Is Nothing Then Exit Sub
    If Application.CountA(Range("D3:G3")) = 4 Then 'Call Changement_etape1
    ElseIf ctl = True Then 'Call Changement_etape2
    End If
End Sub

 

Toujours pas, je ne comprends pas certaines choses à partir de ta boucle "for each c in plg"

Le "c" ca correspond à quoi (si ce n est une variable) ?

Tu as mis cmp1=cmp1=0

Et au vu des lignes de dessus je comprends pas ton "if cmp=cmp1 then ct1 = true" c'est improbable vu que cmp=cmp1=0 ?

Je suis perdu...

Désolé, décidément je ne suis pas réveillé . J'ai édité mon post précédent

Re florian,

Il y a encore un truc qui va pas avec le dernier "elseif" même si je le remplace par un "if" ca marche pas, j'ai beau me creuser les ménages sur ta macro j'arrive pas à débugger, merci pour le temps que tu passes dessus .

Re quiquequoidontou,

J'ai fais le test depuis mon pc ça fonctionne correctement, peux tu me dire ce qui ne fonctionne pas ? quelle type d'erreur as tu ?

Ça me dit:" Erreur de compilation - Else sans if" et il surligne le passage à la fin "Elseif ct1=True then"

J'ai beau faire des tests dans tous les sens impossible à débugger

PS les deux macros appelées sont : changement_etape1 et changement_etape2 (donc j'enleve le petit ' mais ca marche pas quand meme).

Peux tu transmettre ton fichier, car moi je n'ai pas d'erreur

Re bonjour Florian,

J'ai enlevé le reste de mes macros, ce qui rends les autres boutons non fonctionnels car le plus important c'est :

1/Une fois que j'ai rempli le tableau D3:G3 et que toutes les cellules sont modifiées j'appelle la macro changement_etape1

=> Etape1 est surligné en blanc et Etape2 est surligné en vert

2/Une fois que j'ai rempli le tableau "R9,T9", "V9:X9", "Z9:AB9", "AD9:AF9", "AH9:AJ9" et que toutes les cellules sont modifiées j'appelle la macro changement_etape2

=> Etape3 est surligné en blanc et Etape4 est surligné en vert

Je reconnais c'est un peu gadget mais ca reste un challenge pour moi de le reussir.

Une nouvelle fois merci pour ton implication.

Bonjour Quiquequoidontou,

Teste ce code pour ton besoin.

Private Sub Worksheet_Change(ByVal Target As Range)
Nb = Application.CountA(Union([R9:T9], [V9:X9], [Z9:AB9], [AD9:AF9], [AH9:AJ9]))
If Not Intersect(Target, Union([R9:T9], [V9:X9], [Z9:AB9], [AD9:AF9], [AH9:AJ9])) Is Nothing And Nb = 15 Then Call Change_Etape2
If Not Intersect(Target, [D3:G3]) Is Nothing And Application.CountA([D3:G3]) = 4 Then Call Change_Etape1
End Sub

Bonne continuation.

Re quiquequoidontou,

L'erreur est normal comme tu as enlevé le " ' " le bloc If était sur la même ligne, il suffit de mettre à la ligne cette instruction:

Call Changement_etape1

Private Sub Worksheet_change(ByVal Target As Range)
    Dim ctl As Boolean
    Dim lst, Plg As Range
    Dim cmp&, cmp1&
    Dim i, c

        'Array qui contient toutes les zones à scruter
        lst = Array("V9:X9", "Z9:AB9", "AD9:AF9", "AH9:AJ9")
        cmp = 0: cmp1 = 0

        Set Plg = Range("R9:T9")
        'Contrôle des zones
        For i = LBound(lst) To UBound(lst)
            Set Plg = Application.Union(Plg, Range(lst(i)))
        Next i

        For Each c In Plg
            If c <> "" Then cmp = cmp + 1
            cmp1 = cmp1 + 1
        Next c

        If cmp = cmp1 Then ctl = True

    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("D3:G3")) Is Nothing Then Exit Sub
    If Application.CountA(Range("D3:G3")) = 4 Then
        Call Changement_etape1
    ElseIf ctl = True Then Call Changement_etape2
    End If
End Sub

Ca fonctionne pour la macro de X Cellus !!!!

Après avoir testé la tienne flo ca ne semble toujours pas marché sur ma feuille

Un grand merci tout de même à vous deux !