XL 2010 Intersect ne fonctionne pas > version 2

dev_co · 30 Juillet 2021

Bonjour
J'utilise souvent des "Intersect" mais là cela ne marche pas
j'ai fait pas à pas > on passe à la variable 1 , puis ça ,revient au "change" , on repasse à la variable 2 puis à nouveau "change" et là on sort ???
je vois pas !! je ne retouche pas à D1 ??

sylvanu · 30 Juillet 2021

Bonjour Dev_co,
Je ne comprends pas bien la logique avec votre fichier.
Dans l'état avec les colonnes B et D vides vous avez Range("B100").End(xlUp).Row=4
donc les boucles vont de ... 5 à 4 donc ne sont pas effectuées.
Si vous mettez des valeurs en B5:Bxx et D5: Dxx alors effectivement les valeurs entrées sont remplacées par la valeur AR1.
( pour éviter toute ré entrance qui fait perdre du temps, il est utile de rajoutez en début Application.EnableEvents = False et le mettre à True en sortant. )

VB:

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Range("D1"), Target) Is Nothing Then
    Application.EnableEvents = False
    AR1 = Range("D1")
    Range("B4") = AR1
    Range("D4") = AR1

    For x = 5 To Range("B100").End(xlUp).Row
    Range("B" & x) = AR1
    Next x


    For x = 5 To Range("D100").End(xlUp).Row
    Range("D" & x) = AR1
    Next x
    
End If
Application.EnableEvents = True
End Sub

Dranreb · 30 Juillet 2021

Bonjour.
Avant tout changement de contenu de cellule dans une Sub Worksheet_Change mettez Application.EnableEvents = False afin de ne pas provoquer une ré-invocation de cette procédure, pouvant aller parfois jusqu'à la saturation de la pile des appels
N'oubliez pas de remettre Application.EnableEvents = True après le dernier changement.

Jacky67 · 30 Juillet 2021

dev_co à dit:
Bonjour
J'utilise souvent des "Intersect" mais là cela ne marche pas
j'ai fait pas à pas > on passe à la variable 1 , puis ça ,revient au "change" , on repasse à la variable 2 puis à nouveau "change" et là on sort ???
je vois pas !! je ne retouche pas à D1 ??

Bonjour,
Ce n'est pas "Intersect" qui est en cause, mais "Worksheet_Change"
Quand on écrit sur une feuille avec cette macro évènementielle il faut l'instruction:
Application.EnableEvents = False
et
Application.EnableEvents =True
Sinon c'est le serpent qui se mord la queue
Exemple pour la macro

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("D1"), Target) Is Nothing Then
        Application.EnableEvents = False
        [b4:b10,d4:d10] = [d1]
        Application.EnableEvents = True
    End If
End Sub

dev_co · 30 Juillet 2021

Yups ! gros mea culpa ; quelle étourderie .....mal reveillé ?
en tout vous m'avez reveillé !
et oui mes col sont vides dans mon gros fichier , j'ai des données en col - 1 donc j'ai tout repris et c'est ok
merci

ps : je ne sais plus comment on met RESOLU ?

dev_co · 30 Juillet 2021

Re
Bon tout est corrigé
Juste que j'aimerai savoir pourquoi avoir mis une valeur et donc tout rempli si je fais un "sup" donc cell="", on voit tout s'effacer ?

sylvanu · 30 Juillet 2021

Re,
Vraiment pas réveillé, votre macro répète la valeur AR1, donc si AR1 est vide il met vide partout.
Si vous voulez ne rien faire si D1 est vide :

VB:

If Not Intersect(Range("D1"), Target) Is Nothing Then
If Target = "" Then Exit Sub
Application.EnableEvents = False

dev_co · 30 Juillet 2021

Oui je veux tout effacer donc D1 sup et tout s'efface , cela marche mais on voit tout se faire un par un ??

sylvanu · 30 Juillet 2021

Re,
C'est qu'il y a beaucoup de ligne ou beaucoup de calcul, dans ce cas, commencez par :

VB:

Application.ScreenUpdating = false                ' Fige écran'
Application.Calculation = xlCalculationManual    ' Passage en calcul manuel'
Application.EnableEvents = False                ' Inhibe les events'

et finissez par :

Code:

Application.ScreenUpdating = True                    ' Remet écran'
Application.Calculation = xlCalculationAutomatic    ' Passage en calcul automatique'
Application.EnableEvents = True                        ' Réautorise les events'

Cela devrait améliorer la vitesse d'éxécution.

dev_co · 30 Juillet 2021

?? tu as regarder mon fichier ?
Il y a 20 lignes !
Si on met une valeur en D1 tout se rempli puis si on efface D1 on voit bien comme un jeu de dominos tout s'effacer au fur et a mesure !!!!! j'ai jamais vu une Boucle si lente .... pour de 5 à 20 ?

mapomme · 30 Juillet 2021

Bonjour,

Et sans boucle ?

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Intersect(Range("D1"), Target) Is Nothing Then Exit Sub
   Application.ScreenUpdating = False: Application.EnableEvents = False
   Range("b4:b" & Range("A100").End(xlUp).Row) = Range("D1")
   Range("d4:d" & Range("c100").End(xlUp).Row) = Range("D1")
   Application.EnableEvents = True
End Sub

Jacky67 · 30 Juillet 2021

dev_co à dit:
Oui je veux tout effacer donc D1 sup et tout s'efface , cela marche mais on voit tout se faire un par un ??

RE..
Sur la base déjà proposée

sylvanu · 30 Juillet 2021

dev_co à dit:
j'ai jamais vu une Boucle si lente

Sur mon PC et votre fichier il n'y a aucune différence au remplissage ou au vidage.
Sans les verrouillages du post #9, la vitesse me semble correcte.

dev_co · 30 Juillet 2021

Comment faites vous vos insertions de démos visuelles ??
je vais essayer de montrer aussi

mapomme · 30 Juillet 2021

Re @dev_co

Pourquoi utiliser une boucle pour afficher sur la feuille cellule par cellule ?

XL 2010 Intersect ne fonctionne pas > version 2

dev_co

XLDnaute Occasionnel

Pièces jointes

sylvanu

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Jacky67

XLDnaute Barbatruc

dev_co

XLDnaute Occasionnel

dev_co

XLDnaute Occasionnel

Pièces jointes

sylvanu

XLDnaute Barbatruc

dev_co

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

dev_co

XLDnaute Occasionnel

mapomme

XLDnaute Barbatruc

Jacky67

XLDnaute Barbatruc

Pièces jointes

sylvanu

XLDnaute Barbatruc

dev_co

XLDnaute Occasionnel

mapomme

XLDnaute Barbatruc

Discussions similaires