XL 2013 peut-on raccourcir ce code ?

Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Bonjour à touts et à tous,

J'ai le code ci-dessous :
Code: 
Private Sub Worksheet_SelectionChange(ByVal R As Range)
   
    If Not Intersect(R, Range("e23")) Is Nothing And R.Count = 1 Then 'présent(s) au RdV
    qui_sera_au_rdv.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("m9")) Is Nothing And R.Count = 1 Then 'en vente depuis
    agent_indpt.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("o9")) Is Nothing And R.Count = 1 Then 'en vente depuis
    agence.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("r9")) Is Nothing And R.Count = 1 Then 'en vente depuis
    notaire.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("e11")) Is Nothing And R.Count = 1 Then 'en vente depuis
    prepa_mandat.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("r11")) Is Nothing And R.Count = 1 Then 'en vente depuis
    en_vente_depuis.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("v14")) Is Nothing And R.Count = 1 Then 'visites et retours
    visites_retours.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("v17")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    pkoi_pas_vendu.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("m35")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    Quantité.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("m35")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    Quantité.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("o35")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    Quantité.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("r35")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    Quantité.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("t35")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    Quantité.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("v35")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    Quantité.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("x35")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    Quantité.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("e9")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    oui_non.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("e19")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    oui_non.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("i4")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    oui_non.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("g7")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    oui_non.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("k7")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    oui_non.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("t9")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    oui_non.Show
    Range("a1").Activate
    End If
    If Not Intersect(R, Range("v9")) Is Nothing And R.Count = 1 Then 'pas vendu Pkoi ?
    oui_non.Show
    Range("a1").Activate
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Et j'en ai à lui ajouter LOL
J'essaie de le raccourcir mais je n'y arrive pas :confused:

Pourriez-vous m'aider (comme d'hab ,

En vous souhaitant à toutes et à tous un beau WE, je vous remercie d'être tjrs là.
Amicalement,
arthour973
 
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Pour raccourcir un code, mieux vaut pouvoir tester d'abord le code original, non ?
Histoire de vérifier que le code raccourci produit le même résultat.

Mais quand je vois le nombre conséquent d'userform dans ton classeur, mes narines comment à sentir le gaz ;)

Déjà pourquoi ce Range("A1").Activate répété n fois ?!?
 
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
re, voilà !

Private Sub Worksheet_SelectionChange(ByVal R As Range)
If R.Count <> 1 Then Exit Sub
If Not Intersect(R, Range("e23")) Is Nothing Then qui_sera_au_rdv.Show 'présent(s) au RdV
If Not Intersect(R, Range("m9")) Is Nothing Then agent_indpt.Show 'en vente depuis
If Not Intersect(R, Range("o9")) Is Nothing Then agence.Show 'en vente depuis
If Not Intersect(R, Range("r9")) Is Nothing Then notaire.Show 'en vente depuis
If Not Intersect(R, Range("e11")) Is Nothing Then prepa_mandat.Show 'en vente depuis
If Not Intersect(R, Range("r11")) Is Nothing Then en_vente_depuis.Show 'en vente depuis
If Not Intersect(R, Range("v14")) Is Nothing Then visites_retours.Show 'visites et retours
If Not Intersect(R, Range("v17")) Is Nothing Then pkoi_pas_vendu.Show 'pas vendu Pkoi ?
If Not Intersect(R, Range("m35, o35, r35, t35, v35, x35")) Is Nothing Then Quantité.Show 'pas vendu Pkoi ?
If Not Intersect(R, Range("e9, e19, i4, g7, k7, t9, v9")) Is Nothing Then oui_non.Show 'pas vendu Pkoi ?
Range("a1").Activate: Application.EnableEvents = True: Application.ScreenUpdating = True
End Sub
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Re Bonjour Roland, JM

J'ai juste modifié le code comme suit :
Code: 
Private Sub Worksheet_SelectionChange(ByVal R As Range)
Application.EnableEvents = False: Application.ScreenUpdating = False
If R.Count <> 1 Then Exit Sub
If Not Intersect(R, Range("e23")) Is Nothing Then qui_sera_au_rdv.Show: [a1].Activate
If Not Intersect(R, Range("m9")) Is Nothing Then agent_indpt.Show: [a1].Activate
If Not Intersect(R, Range("o9")) Is Nothing Then agence.Show: [a1].Activate
If Not Intersect(R, Range("r9")) Is Nothing Then notaire.Show: [a1].Activate
If Not Intersect(R, Range("e11")) Is Nothing Then prepa_mandat.Show: [a1].Activate
If Not Intersect(R, Range("r11")) Is Nothing Then en_vente_depuis.Show: [a1].Activate
If Not Intersect(R, Range("v14")) Is Nothing Then visites_retours.Show: [a1].Activate
If Not Intersect(R, Range("v17")) Is Nothing Then pkoi_pas_vendu.Show: [a1].Activate
If Not Intersect(R, Range("m35, o35, r35, t35, v35, x35")) Is Nothing Then Quantité.Show: [a1].Activate
If Not Intersect(R, Range("e9, e19, i4, g7, k7, t9, v9")) Is Nothing Then oui_non.Show: [a1].Activate
Application.EnableEvents = True: Application.ScreenUpdating = True
End Sub
Car "Range("a1").Activate" ne doit s'exécuter que si clic sur les cellules appelant les userForm.
Bon WE
amicalement,
arthour973
 
Vote positif 0 Vote négatif
S

Si...

XLDnaute Barbatruc
Bon_jour
un truc "Select" à ne pas négliger :
VB: 
Private Sub Worksheet_SelectionChange(ByVal R As Range)
  Application.EnableEvents = 0
  Select Case R.Address
    Case "$E$23": qui_sera_au_rdv.Show: [A1].Select
    Case "$M$9": agent_indpt.Show: [A1].Select
    Case "$O$9": agence.Show: [A1].Select
    Case "$R$9": notaire.Show: [A1].Select
    Case "$E$11": prepa_mandat.Show: [A1].Select
    Case "$R$11": en_vente_depuis.Show: [A1].Select
    Case "$V$14": visites_retours.Show: [A1].Select
    Case "$V$17": pkoi_pas_vendu.Show: [A1].Select
    Case "$M$35", "$O$35", "$R$35", "$T$35", "$V$35", "$X$35": Quantité.Show: [A1].Select
    Case "$E$9", "$E$19", "$i$4", "$g$7", "$k$7", "$T$9", "$V$9": oui_non.Show: [A1].Select
  End Select
  Application.EnableEvents = 1
End Sub
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Bonjour SI,

Merci d'être là :)

"[a1].Activate" est juste pour sortir de la cellule et ne pas avoir à cliquer "ailleurs" puis revenir si on s'est trompé de sélection dans userform.

Pkoi c'est mieux le "select" ?

Nota : j'ai souvent lu que trop de sélects n'était pas bon ?
 
Vote positif 0 Vote négatif

Discussions similaires

Sellig
  • Résolu(e)
XL 2019 Sélection zone avec la souris et copier puis Sélection zone avec la souris et coller
Réponses
9
Affichages
456
Sellig
Sellig
S
  • Question
Microsoft 365 Clavier virtuel: SelectionChange, empêche la répétition
Réponses
3
Affichages
318
Simon 1234
S
PORCHER
  • Question
Microsoft 365 Incompatibilité de type
Réponses
1
Affichages
229
Dranreb
Dranreb
U
  • Question
Autres [RESOLU] Déclaration de variable
Réponses
5
Affichages
412
un internaute
U
Jojo973
  • Question
Microsoft 365 Trouver et attribuer une plage de cellule en fonction de la cellule active
Réponses
6
Affichages
344
Jojo973
Jojo973
P
  • Résolu(e)
Microsoft 365 Private Sub Worksheet_Change(ByVal Target As Range)
Réponses
8
Affichages
593
pat66
P
C
  • Question
XL 2016 VBA Détecter la suppression de la dernière ligne d'un Tableau
Réponses
9
Affichages
390
crocrocro
C
ralph45
  • Question
Microsoft 365 [VBA] Listes déroulantes à choix multiples sur N colonnes discontinues
Réponses
4
Affichages
498
ralph45
ralph45
R
  • Résolu(e)
XL 2019 Plusieurs Worksheet_Change sur la même feuille
Réponses
9
Affichages
506
Rabeto
R
chaelie2015
  • Question
XL 2013 Réduire un code
Réponses
0
Affichages
450
chaelie2015
chaelie2015

Membres actuellement en ligne

4 membres et 72 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 450
Messages
2 109 730
Membres
110 553
dernier inscrit
loic55