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

 

[Hellboy]

Bonjour michel33

Excuse du délais de réponce...

Essaie ceci à la place:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range('d3:g115')) Is Nothing Then Exit Sub
Efface_et_couleur
End Sub

Public Sub Efface_et_couleur()
Dim cell As Range
Dim Icouleur As Integer
Application.ScreenUpdating = False
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'
                     Icouleur = 3
                Case 'ros'
                     Icouleur = 22
                Case 'b'
                     Icouleur = 19
         End Select
        .Select
        .Font.ColorIndex = Icouleur
        .Interior.ColorIndex = Icouleur
    End With
Next cell
End Sub

Message édité par: Hellboy, à: 09/05/2005 04:18

 

[ERIC S]

Bonjour

c'est le WE et le retour à la maison. Ma famille m'a transmis ton fichier par mail

A partir de celui-ci je te propose le fichier joint, à tester.

A noter que je n'utilise pas systématiquement les macros car excel fait déjà beaucoup de choses (validation, filtre...)

je n'ai pas eu le temps de me pencher sur la macro flash que tu utilises. Il faudrait invalider la sélection de cellule tant que le flash n'est pas fini (il faut voir s'il existe des wait, sleep...)

A+ [file name=Cave1.zip size=27390]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Cave1.zip[/file]

 

[michel33]

bonjour Eric
merci pour le fichier;je ne l'ai eu que ce matin(pas eu le temps de me connecter hier).Je vais le tester et je te tiens au courant.
Pour ce qui est de la macro flash,le probleme est resolu
A plus tard
michel33

 

[michel33]

bonjour aux utilisateurs du forum
que faut-il rajouter a cette ligne:
If LCase(Left$(Target.Value, 3)) = 'rou' Then Target.Value = 'Rouge'
pour que le texte'rouge' apparaisse en rouge ?

pour Eric S en particulier:
j'ai commencé à regarder ton fichier;et je vais utiliser une partie de tes recherches pour modifier mon projet qui a evolué depuis
Je te l'enverrai ultérieurement pour me donner ton avis
A+
michel33

 

[michel33]

oops!
désolé pour cette question stupide;avec la mise en forme conditionnelle,c'est enfantin

michel33

 

[Canardo]

:angry:
Il est temps d'avoir un fichier, camarade!

Comme l'a écrit Francis, je crois, '....il est vivement conseillé de mettre un fichier joint(Zip -50Ko sans accent ni caractères spéciaux)car il nous faut a chaque fois construire le fichier ..... et c'est pas encourageant donc mets un extrait de ton fichier....

En plus ils sont tous à la messe, apparemment, car il y a pas grand monde par ici en ce moment :evil:

A part ça, une remarque que je crois importante, tu marques à une ligne .clear ce qui supprime toute mise en forme. est-ce intentionnel?