Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

M

Myaah

XLDnaute Nouveau
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.
 
Trier par date Trier par votes

Dranreb

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif

xUpsilon

XLDnaute Accro
Bonjour,

VB: 
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
 
Vote positif 0 Vote négatif

AtTheOne

XLDnaute Impliqué
Supporter XLD
bonjour à toutes & à tous,
bonjour @Myaah

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

VB: 
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
 
Vote positif 0 Vote négatif
M

Myaah

XLDnaute Nouveau
MERCI !!! ça fonctionne parfaitement.
Au top, merci infiniment !
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

P
  • Résolu(e)
Microsoft 365 Private Sub Worksheet_Change(ByVal Target As Range)
Réponses
8
Affichages
332
pat66
P
  • Question
Microsoft 365 L'indice n'appartient pas à la sélection
Réponses
8
Affichages
316
TooFatBoy
  • Résolu(e)
XL 2016 Indice n'appartient pas à la sélection : HELP !!!!
2
Réponses
21
Affichages
549
halecs93
R
  • Résolu(e)
XL 2019 Plusieurs Worksheet_Change sur la même feuille
Réponses
9
Affichages
323
Rabeto
R
  • Question
Microsoft 365 VBA Transpose
Réponses
11
Affichages
297
sylvanu
P
  • Résolu(e)
Microsoft 365 Copier coller une cellule avant qu'elle ne soit modifiée par Sub Worksheet_Change(ByVal Target As Range)
2
Réponses
19
Affichages
717
pat66
P
P
  • Résolu(e)
XL 2019 Conditions dans Worksheet_Change(ByVal Target As Range)
Réponses
4
Affichages
349
pat66
P
M
  • Résolu(e)
XL 2016 Private Sub ne fonctionne pas
Réponses
4
Affichages
220
MaNU84510
M
C
  • Résolu(e)
XL 2021 Aide pour affichage colonne listbox après une recherche par textbox
Réponses
10
Affichages
261
Claudinedu13
C
P
  • Résolu(e)
XL 2019 Plusieurs conditions avec Sub Worksheet_Change (ByVal Target As Range)
2
Réponses
18
Affichages
697
pat66
P
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…