Optimisation de code

Bonjour tout le monde,

J'ai un code qui fonctionne bien, mais j'aimerai savoir si il est possible de l'optimiser.

Je le trouve un peu long et j'aimerai savoir si on peut l'écrire différement pour gagner du temps.

Voilà le code en question ci-dessous qui est dans un module.

Je l'appelle via la fonction call dans le code de la feuille concernée.

Je précise que les cellules AA26 et AF26 sont des formules qui se caluculent en fonction d'autres cellules.

Le code du module:

Sub PASWolf()

Application.ScreenUpdating = False

'copie le taux du PAS
Dim PASWolf As Range
Dim n As Integer
n = 4
Set PASWolf = Cells(n, 5)

    If Range("E4").Value = "" Then
        PASWolf.Formula = Range("AA26").Text
    End If

    If Range("E4").Value <> "" And Range("E5") = "" Then
      Set PASWolf = Cells(n + 1, 5)
      PASWolf.Formula = Range("AF26").Text
    End If
    If Range("E4").Value <> "" And Range("E5") <> "" Then
      Set PASWolf = Cells(n + 2, 5)
      PASWolf.Formula = Range("AF26").Text
    End If

Application.ScreenUpdating = True

End Sub

Et voilà le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim KeyCells5 As Range
Set KeyCells5 = Union(Range("L5"), Range("L10:L16"), Range("E22:E29"), Range("P9"))

    If Not Intersect(KeyCells5, Target) Is Nothing Then
    Call PASWolf
    End If

End Sub

Merci de votre aide et de vos suggestions.
Bon weekend en avance
A++

Wolf76

Hello,

Essaie ça :

Sub PASWolf()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'copie le taux du PAS
Dim PASWolf As Range
Dim n As Integer
n = 4
Set PASWolf = Cells(n, 5)

    If Range("E4").Value = "" Then
        PASWolf.Formula = Range("AA26").Text
    End If

    If Range("E4").Value <> "" And Range("E5") = "" Then
      Set PASWolf = Cells(n + 1, 5)
      PASWolf.Formula = Range("AF26").Text
    End If
    If Range("E4").Value <> "" And Range("E5") <> "" Then
      Set PASWolf = Cells(n + 2, 5)
      PASWolf.Formula = Range("AF26").Text
    End If

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

R@g

Bonsoir Rag, bonsoir le forum,

J'aurais plutôt simplifier comme ça même si ça ne va pas rendre le code beaucoup plus rapide...:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells5 As Range

Set KeyCells5 = Union(Range("L5"), Range("L10:L16"), Range("E22:E29"), Range("P9"))
If Not Intersect(KeyCells5, Target) Is Nothing Then
    If Range("E4").Value = "" Then Range("E4").Value = Range("AA26").Value
    If Range("E4").Value <> "" And Range("E5") = "" Then Range("E5").Value = Range("AF26").Value
    If Range("E4").Value <> "" And Range("E5") <> "" Then Range("E6").Value = Range("AF26").Value
End If
End Sub

Bonsoir le fil, bonsoir le forum,

Il y a tellement peu de changements que je ne le juge pas nécessaire mais de le laisser ne nuira pas non plus...

Bonjour à tous,

Cette macro est lente ? Normalement, il devrait y avoir un résultat instantané. Je rejoins Thauthème sur la méthode et pousse encore plus loin en proposant la propriété value2 qui, je le crois est plus rapide et 0 variable, y compris dans la macro change. A la place, il faudra nommer l'union des cellules "Keycells5".

Mais je doute que ça change beaucoup dans ce contexte.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("Keycells5"), Target) Is Nothing Then
    Call PASWolf
End If
End Sub

Sub PASWolf()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Range("E4").Value = "" Then
    Range("E4").Formula = Range("AA26").value2
else
    if Range("E5") = "" Then Range("E5").Formula = Range("AF26").value2 else Range("E6").Formula = Range("AF26").value2
end if
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Cdlt,

Bonjour 3GB, ThauThème et R@g02700,

Merci à tous les 3 pour vos solutions qui fonctionnent.

Néanmoins, j'ai un faible pour la solution de 3GB.

Je note le post en résolu.

Merci encore.

Bon weekend.

A++

Wolf76