lenteur fichier

[Mitch]

Bonsoir a tous , voila j'ai un fichier avec ,Nom Prénom etc , j'ai des MFC pour les doublons et cette macro , mais voila mon fichier est très long a reagir a chaque saisi , peut on simplifier ma macro je pense que c'est ça qui ralenti .
Merci

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range
If Not Intersect(Target, [B2:B2000]) Is Nothing Then
Application.EnableEvents = False
For Each cel In Intersect(Target, [B2:B2000]).Cells
cel = UCase(cel)
Next cel
Application.EnableEvents = True
End If
If Not Intersect(Target, [F2:F2000]) Is Nothing Then
Application.EnableEvents = False
For Each cel In Intersect(Target, [F2:F2000]).Cells
cel = UCase(cel)
Next cel
Application.EnableEvents = True
End If
If Not Intersect(Target, [C2:C2000]) Is Nothing Then
Application.EnableEvents = False
For Each cel In Intersect(Target, [C2:C2000]).Cells
cel = WorksheetFunction.Proper(cel)
Next cel
Application.EnableEvents = True
End If
If Not Intersect(Target, [G2:G2000]) Is Nothing Then
Application.EnableEvents = False
For Each cel In Intersect(Target, [G2:G2000]).Cells
cel = WorksheetFunction.Proper(cel)
Next cel
Application.EnableEvents = True
End If
If Not Intersect(Target, [H2:H2000]) Is Nothing Then
Application.EnableEvents = False
For Each cel In Intersect(Target, [H2:H2000]).Cells
cel = WorksheetFunction.Proper(cel)
Next cel
Application.EnableEvents = True
End If
If Not Intersect(Target, [I2:I2000]) Is Nothing Then
Application.EnableEvents = False
For Each cel In Intersect(Target, [I2:I2000]).Cells
cel = WorksheetFunction.Proper(cel)
Next cel
Application.EnableEvents = True
End If
If Not Intersect(Target, [J2:J2000]) Is Nothing Then
Application.EnableEvents = False
For Each cel In Intersect(Target, [J2:J2000]).Cells
cel = WorksheetFunction.Proper(cel)
Next cel
Application.EnableEvents = True
End If
If Not Intersect([P2:R2000], Target) Is Nothing And Target.Count = 1 Then
If Target <> "" Then
Application.EnableEvents = False
valsaisie = Target
Application.Undo
If Left(Target.Formula, 1) = "=" Then
Target.Formula = Target.Formula & "+" & valsaisie
Else
Target.Formula = "=" & valsaisie
End If
Application.EnableEvents = True
End If
End If
End Sub

 

[mth]

Re : lenteur fichier

Bonsoir,

Un essai pour le début (pas trop compris sur la fin) mais au cas où :

Private Sub Worksheet_Change(ByVal Target As Range)
Static b As Boolean
Dim cel As Range
If b = False And Target.Count = 1 And Not Intersect(Target, Union([B2:B2000], [F2:F2000])) Is Nothing Then
    b = True
    On Error Resume Next
    Target.Value = UCase(Target.Value)
    b = False
End If
If b = False And Target.Count = 1 And Not Intersect(Target, Union([C2:C2000], [G2:G2000], [H2:H2000], [I2:J2000])) Is Nothing Then
    b = True
    On Error Resume Next
    Target.Value = WorksheetFunction.Proper(Target.Value)
    b = False
End If
If Not Intersect([P2:R2000], Target) Is Nothing And Target.Count = 1 Then
'suite de ton code

Tu auras certainement d'autres suggestions bien meilleures que la mienne, bonne soirée,

mth

 

[Bebere]

Re : lenteur fichier

bonjour Mth
vois si ce code peut te venir en aide

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range, L As Long, C As Integer
If Target.Count = 1 Then
Application.ScreenUpdating = False
C = Target.Column
L = Cells(3000, C).End(xlUp).Row
Application.EnableEvents = False
For Each Cel In Range(Cells(2, C), Cells(L, C))
Select Case C
Case 2, 6
Cel = UCase(Cel)
Case 3, 7, 8, 9, 10
Cel = WorksheetFunction.Proper(Cel)
End Select
Next Cel
Application.EnableEvents = True
If Not Intersect([P2:R2000], Target) Is Nothing Then
If Target <> "" Then
Application.EnableEvents = False
valsaisie = Target
Application.Undo
If Left(Target.Formula, 1) = "=" Then
Target.Formula = Target.Formula & "+" & valsaisie
Else
Target.Formula = "=" & valsaisie
End If
Application.EnableEvents = True
End If
End If
Application.ScreenUpdating = True

End If
End Sub

 

[Mitch]

Re : lenteur fichier

Merci mth et Bebere pour vos reponses j'essais des demain , bonne soirée

 

[Bebere]

Re : lenteur fichier

bonjour Mitch,Mth
après réflexion, pas besoin de boucle puisque cela se passe lorsque tu fais une entrée
à bientôt