XL 2010 Intersect ne fonctionne pas > version 2

[dev_co]

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]

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. )

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]

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]

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

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]

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]

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]

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 :

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

 

[dev_co]

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

 

[sylvanu]

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

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

et finissez par :

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]

?? 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]

Bonjour,

Et sans boucle ?

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]

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]

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]

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

 

[mapomme]

Re @dev_co

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