lenteur macro

[michel33]

bonjour
dans cette macro,j'ai integre une ligne permettant de
convertir les minuscules en majuscules;seulement la macro met
longtemps a s'executer.je pense qu'il s'agit d'un probleme de
conception de la macro,mais je ne sais pas comment l'ecrire
autrement:

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.ScreenUpdating = False
If Intersect(Target, Range('d3:g115')) Is Nothing Then Exit Sub
For Each cell In Range('d3:g115')
If cell.Value = '' Then
cell.Offset(0, 1).ClearContents 'effacement
cell.Offset(0, 2).ClearContents 'effacement
cell.Offset(0, 3).Clear 'effacement
End If
If cell.Offset(0, 3).Value = 'rou' Then 'mefc
cell.Offset(0, 3).Font.ColorIndex = 3 'mefc
cell.Offset(0, 3).Interior.ColorIndex = 3 'mefc
ElseIf cell.Offset(0, 3).Value = 'ros' Then 'mefc
cell.Offset(0, 3).Font.ColorIndex = 22 'mefc
cell.Offset(0, 3).Interior.ColorIndex = 22 'mefc
ElseIf cell.Offset(0, 3).Value = 'b' Then 'mefc
cell.Offset(0, 3).Font.ColorIndex = 19 'mefc
cell.Offset(0, 3).Interior.ColorIndex = 19 'mefc
End If
cell.Value = UCase(cell.Value) 'minuscules en majuscules
Next cell
End Sub

je cherche depuis pas mal de temps,mais pas de solution
merci pour l'aide
michel33

 

[ERIC S]

Salut,

dans ta macro, à chaque fois que tu sélectionne une cellule dan sla plage D3:G115, tu balayes toutes les cellules de la plage en questionsoit environ 500 cellules.

est-ce normal ?

 

[Arnaud]

salut,

j'ai observé la même chose que toi éric. ( 452 cellules pour être précis ) Donc par rapport a cela le tps de traitement me parai assez aproprié. Ce n'est d'ailleur par spécialement le UCase qui prend énormement de tps, c'est juste que cela fais pas mal de traitement d'un coup...

 

[michel33]

bonjour ERIC S
effectivement c'est lourd comme solution,mais n'etant pas un pro
de la macro,je n'ai pas su l'ecrire autrement
A +
michel33

 

[ERIC S]

suite

la question est que veux-tu faire?

tu sélectionne une cellule de ta plage

ensuite que doit-il se passer ?

 

[michel33]

bonjour eric

cette macro sert a effacer 3 cellules sur la meme ligne si la premiere
cellule est vide(ex:si d3 est vide alors e3,f3 et g3 se vident
automatiquement)
la deuxieme partie de la macro est une mise en forme conditionnelle
des cellules de la colonne 'g'(suivant le texte rentré la cellule prend une couleur differente
la derniere partie est la mise en majuscule dans les colonnes d,e et f

voila donc les fonctions de la macro;si tu veux plus de renseignements,pas de probleme.

merci de t'occuper de mon probleme
A+

michel33

 

[Hellboy]

Bonjour michel33 Eric S et Arnaud

est-ce que ceci fait l'affaire ?

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.ScreenUpdating = False
If Intersect(Target, Range('d3:g115')) Is Nothing Then Exit Sub
Range('B8:D115').SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For Each cell In Range('E8:E' & Range('D65536').End(xlUp).Row)
    With cell
         Select Case .Value
                Case 'rou'
                     icolor = 3
                Case 'ros'
                     icolor = 22
                Case 'b'
                     icolor = 19
         End Select
        .Select
        .Font.ColorIndex = icolor
        .Interior.ColorIndex = icolor
    End With
Next cell
End Sub

Philippe

 

[michel33]

bonsoir hellboy
si j'utilise ta macro,j'ai un retour d'erreur de syntaxe sur la ligne:
  icolor = 3
je travaille avec office 97;est-ce la cause?
A+
michel33

 

[ERIC S]

bonjour

pas dispo ces dernières heures

remarques

1/ si tu ne veux travailler que sur la ligne dont tu pointes la cellule en D essaie en modifiant tes lignes

If Intersect(Target, Range('d3:d115')) Is Nothing Then Exit Sub

'For Each cell In Range('d3:g115') ' mise en commentaire

'Next Cell ' mise en commentaire

2/ si tu veux mettre à jour ta zone une fois de temps en temps crée un bouton et affecte ta macro, afin qu'elle ne s'exécute pas à chaque sélection

A+

 

[michel33]

bonjour ERIC S
j'ai suivi ton conseil
mais erreur d'execution sur la ligne:If cell.Value = '' Then
erreur=objet requis
par contre l'idée du bouton ne me convient pas car ma feuille
doit se mettre a jour immediatement
A+
michel33

 

[ERIC S]

re

essaie avec

if target.value = ''
ou
if activecell.value=''

dans les autres lignes il faudra sans doute aussi changer le cell

A+

 

[ERIC S]

re

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.ScreenUpdating = False
If Intersect(Target, Range('d3:d115')) Is Nothing Then Exit Sub
If Target.Value = '' Then
Target.Offset(0, 1).ClearContents 'effacement
Target.Offset(0, 2).ClearContents 'effacement
Target.Offset(0, 3).Clear 'effacement
End If
If Target.Offset(0, 3).Value = 'rou' Then 'mefc
Target.Offset(0, 3).Font.ColorIndex = 3 'mefc
Target.Offset(0, 3).Interior.ColorIndex = 3 'mefc
ElseIf Target.Offset(0, 3).Value = 'ros' Then 'mefc
Target.Offset(0, 3).Font.ColorIndex = 22 'mefc
Target.Offset(0, 3).Interior.ColorIndex = 22 'mefc
ElseIf Target.Offset(0, 3).Value = 'b' Then 'mefc
Target.Offset(0, 3).Font.ColorIndex = 19 'mefc
Target.Offset(0, 3).Interior.ColorIndex = 19 'mefc
End If
Target.Value = UCase(Target.Value) 'minuscules en majuscules
End Sub


A+

 

[michel33]

merci ERIC S de passer autant de temps sur mon pb
si j'essaie ta macro,il faut revenir sur une case de la coloneD
pour valider les modifs,ce qui est genant
ci-joint mon fichier(avec ses imperfections) afin que tu puisse voir ce
que je veux
A+
michel33

 

[ERIC S]

RE

Il n'y a pas de fichier joint et pour moi le WE se termine, je bosse à 250kms de chez moi, avec très peu de possibilités de connexions forum

envoie moi le fichier sur eric.seigneur@freesbee.fr, ma famille fera suivre

effectivement il faut comprendre ce que tu veux

en aveugle je te propose un autre essai, remets

If Intersect(Target, Range('d3:g115')) Is Nothing Then Exit Sub

la macro marchera sur n'importe quelle cellule entre d3 et G115 mais seulement au niveau de la cellule pointée

A+

 

[michel33]

merci ERIC S pour ta disponibilité ce WE
pour le fichier joint,ildepassait un peu les 50ko donc iln'asurement pas du etre transmis
je fais un test suivant tes conseils et je te tiens au courant
bonne semaine et a bientot
michel33