Autres VBA - cumuler 2 Private Sub Worksheet_change(ByVal Target As Range)

[Myaah]

Bonjour,

Je souhaiterais cumuler, sur une même page, ces deux codes :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t, r, i As Long, ech As Boolean, aux, s$
If Intersect(Target, Range("N3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
t = Range("T1:U49").Value
For i = 2 To UBound(t)
If t(i, 1) = Target Then t(i, 2) = t(i, 2) + 1: Exit For
Next i
Range("T1:U49") = t
Range("T1:U49").Sort key1:=Range("U1"), order1:=xlDescending, key2:=Range("T1"), order2:=xlAscending, _
MatchCase:=xlNo, Header:=xlYes
r = Range("T1:U49").Value: Range("T1:U49") = t
For i = 2 To 4
If r(i, 2) <> "" And r(i, 2) <> "" Then s = s & " / " & r(i, 1)
Next i
Range("Q3").ClearContents
If s <> "" Then Range("Q3") = Mid(s, 3)
End sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("N4")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
t = Range("V1:W26").Value
For i = 2 To UBound(t)
If t(i, 1) = Target Then t(i, 2) = t(i, 2) + 1: Exit For
Next i
Range("V1:W26") = t
Range("V1:W26").Sort key1:=Range("W1"), order1:=xlDescending, key2:=Range("V1"), order2:=xlAscending, _
MatchCase:=xlNo, Header:=xlYes
r = Range("V1:W26").Value: Range("V1:W26") = t
For i = 2 To 4
If r(i, 2) <> "" And r(i, 2) <> "" Then s = s & " / " & r(i, 1)
Next i
Range("Q4").ClearContents
If s <> "" Then Range("Q4") = Mid(s, 3)

End Sub


Sauriez-vous comment je peux m'y prendre ? J'ai compris que l'on ne peut pas cumuler 2 Private Sub Worksheet_Change normalement, cependant ils n'entrent pas "en conflit" et chaque code est associé à des cellules différentes, j'imagine donc bien que cela est possible mais je ne trouve pas comment.

Merci par avance !


Excel 2007 FR.

 

[Dranreb]

Bonjour.
Si une seule cellule est modifiée chaque fois vous pouvez mettre un Select Case Target.Address puis
Case "$N$3" suivi du code de la 1ère
Case "$N$4" suivi de code de la seconde
End Select

 

[xUpsilon]

Bonjour,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t, r, i As Long, ech As Boolean, aux, s$
If Not (Intersect(Target, Range("N3")) Is Nothing) Then
    Application.ScreenUpdating = False
    t = Range("T1:U49").Value
    For i = 2 To UBound(t)
        If t(i, 1) = Target Then t(i, 2) = t(i, 2) + 1: Exit For
    Next i
    Range("T1:U49") = t
    Range("T1:U49").Sort key1:=Range("U1"), order1:=xlDescending, key2:=Range("T1"), order2:=xlAscending, _
    MatchCase:=xlNo, Header:=xlYes
    r = Range("T1:U49").Value: Range("T1:U49") = t
    For i = 2 To 4
        If r(i, 2) <> "" And r(i, 2) <> "" Then s = s & " / " & r(i, 1)
    Next i
    Range("Q3").ClearContents
    If s <> "" Then Range("Q3") = Mid(s, 3)
End if

If Not (Intersect(Target, Range("N4")) Is Nothing) Then
    Application.ScreenUpdating = False
    t = Range("V1:W26").Value
    For i = 2 To UBound(t)
        If t(i, 1) = Target Then t(i, 2) = t(i, 2) + 1: Exit For
    Next i
    Range("V1:W26") = t
    Range("V1:W26").Sort key1:=Range("W1"), order1:=xlDescending, key2:=Range("V1"), order2:=xlAscending, _
    MatchCase:=xlNo, Header:=xlYes
    r = Range("V1:W26").Value: Range("V1:W26") = t
    For i = 2 To 4
        If r(i, 2) <> "" And r(i, 2) <> "" Then s = s & " / " & r(i, 1)
    Next i
    Range("Q4").ClearContents
    If s <> "" Then Range("Q4") = Mid(s, 3)
End if

End Sub

Comme ceci ?

Bonne journée,

PS : Bonjour Dranreb

 

[AtTheOne]

bonjour à toutes & à tous,
bonjour @Myaah

effectivement un seule procédure Worksheet_Change par feuille :
En t'y prennant de la manière suivante

Private Sub Worksheet_Change(ByVal Target As Range)
'Tes déclarations
...
If not Intersect(Target, Me.[N3]) is nothing then
    'Actions pour N3
   Exit sub
End if
If not Intersect(Target, Me.[N4]) is nothing then
    'Actions pour N4
   Exit sub
End if
 ...
End Sub

Remarque si Target recouvre N3 et N4 (action sur plusieurs cellules) les deux parties seront exécutées.

Bon courage

 

[Myaah]

Bonjour,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t, r, i As Long, ech As Boolean, aux, s$
If Not (Intersect(Target, Range("N3")) Is Nothing) Then
    Application.ScreenUpdating = False
    t = Range("T1:U49").Value
    For i = 2 To UBound(t)
        If t(i, 1) = Target Then t(i, 2) = t(i, 2) + 1: Exit For
    Next i
    Range("T1:U49") = t
    Range("T1:U49").Sort key1:=Range("U1"), order1:=xlDescending, key2:=Range("T1"), order2:=xlAscending, _
    MatchCase:=xlNo, Header:=xlYes
    r = Range("T1:U49").Value: Range("T1:U49") = t
    For i = 2 To 4
        If r(i, 2) <> "" And r(i, 2) <> "" Then s = s & " / " & r(i, 1)
    Next i
    Range("Q3").ClearContents
    If s <> "" Then Range("Q3") = Mid(s, 3)
End if

If Not (Intersect(Target, Range("N4")) Is Nothing) Then
    Application.ScreenUpdating = False
    t = Range("V1:W26").Value
    For i = 2 To UBound(t)
        If t(i, 1) = Target Then t(i, 2) = t(i, 2) + 1: Exit For
    Next i
    Range("V1:W26") = t
    Range("V1:W26").Sort key1:=Range("W1"), order1:=xlDescending, key2:=Range("V1"), order2:=xlAscending, _
    MatchCase:=xlNo, Header:=xlYes
    r = Range("V1:W26").Value: Range("V1:W26") = t
    For i = 2 To 4
        If r(i, 2) <> "" And r(i, 2) <> "" Then s = s & " / " & r(i, 1)
    Next i
    Range("Q4").ClearContents
    If s <> "" Then Range("Q4") = Mid(s, 3)
End if

End Sub

Comme ceci ?

Bonne journée,

PS : Bonjour Dranreb

MERCI !!! ça fonctionne parfaitement.
Au top, merci infiniment !

 

[AtTheOne]

Bonjour @Myaah
Peux-tu marquer le post de @xUpsilon comme solution ?
Merci