XL 2016 VBA Simplifier une formule

[Paillou]

Bonjour,

Je débute en VBA et j'ai besoin d'aide pour simplifier une formule.

J'ai répété le code pour chaque ligne ou j'ai besoin de la ligne 10 à 65 mais le fichier rame.

Voici le début de mon code VBA :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Range("i10:i65").NumberFormat = "mmm yy"
Range("f10:f65").NumberFormat = "dd mmm yy"

If Range("f10") = "" Then
Range("i10") = " "
ElseIf Range("f10") < Now() Then
Range("i10") = "=DATE(YEAR(RC[-3])+VALUE(LEFT(RC[-1],1)),MONTH(RC[-3]),DAY(RC[-3]))"
End If

If Range("f11") = "" Then
Range("i11") = " "
ElseIf Range("f11") < Now() Then
Range("i11") = "=DATE(YEAR(RC[-3])+VALUE(LEFT(RC[-1],1)),MONTH(RC[-3]),DAY(RC[-3]))"
End If

If Range("f12") = "" Then
Range("i12") = " "
ElseIf Range("f12") < Now() Then
Range("i12") = "=DATE(YEAR(RC[-3])+VALUE(LEFT(RC[-1],1)),MONTH(RC[-3]),DAY(RC[-3]))"
End If

[......]

End sub

Merci d'avance pour votre aide

 

[sylvanu]

Bonsoir paillou,
Une possibilité :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("I10:I65").NumberFormat = "mmm yy"
Range("F10:F65").NumberFormat = "dd mmm yy"
For L = 10 To 65
    If Cells(L, "F") = "" Then
        Cells(L, "I") = " "
    ElseIf Cells(L, "F") < Now() Then
        Cells(L, "I") = "=DATE(YEAR(RC[-3])+VALUE(LEFT(RC[-1],1)),MONTH(RC[-3]),DAY(RC[-3]))"
    End If
Next L
End Sub

ou encore, si vous préférez les Range :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("I10:I65").NumberFormat = "mmm yy"
Range("F10:F65").NumberFormat = "dd mmm yy"
For L = 10 To 65
    If Range("F" & L) = "" Then
        Range("I" & L) = " "
    ElseIf Range("F" & L) < Now() Then
        Range("I" & L) = "=DATE(YEAR(RC[-3])+VALUE(LEFT(RC[-1],1)),MONTH(RC[-3]),DAY(RC[-3]))"
    End If
Next L
End Sub

Pour le code utilisez les balises </> c'est plus lisible ( à droite de l'icone GIF )

 

[Paillou]

Salut sylvanu.

Merci beaucoup pour ton aide.

Ça règle le problème de la longueur du code mais le fichier rame toujours autant.

Dans mon fichier, certaines lignes (de 10 à 65) sont masquées en fonction des certains paramètres pré remplis. Est ce que qu’on rajouter un élément dans le code pour ça rame moins ?

Cordialement,

 

[sylvanu]

Bonsoir,
Pouvez vous fournir un petit fichier test, car telle qu'ecrite la macro est très rapide.
Si ca rame, c'est à cause d'autre chose. Il y a tellement de causes possible.

 

[sylvanu]

Peut être une piste, si vous avez beaucoup de calculs, d'évents ... on fige tout au départ puis on remet à la fin.
Testez pour voir :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' On fige tout
Application.ScreenUpdating = False              ' on fige l'écran
Application.Calculation = xlCalculationManual   ' calcul non automatique
Application.EnableEvents = False                ' on blowue tout event
Application.DisplayAlerts = False               ' on bloque les alertes.

Range("I10:I65").NumberFormat = "mmm yy"
Range("F10:F65").NumberFormat = "dd mmm yy"
For L = 10 To 65
    If Cells(L, "F") = "" Then
        Cells(L, "I") = " "
    ElseIf Cells(L, "F") < Now() Then
        Cells(L, "I") = "=DATE(YEAR(RC[-3])+VALUE(LEFT(RC[-1],1)),MONTH(RC[-3]),DAY(RC[-3]))"
    End If
Next L

' On remet tout
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub

 

[sylvanu]

Un autre souci potentiel est que vous exécutez cette macro dès qu'on change une valeur dans une cellule quelconque.
On pourrait restreindre facilement l'exécution de cette macro en limitant les cellules concernées.
Par exemple, comme ci dessous, on n'exécute cette macro que si on change une valeur dans la plage F10:F65. Ca accélère les choses.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("F10:F65")) Is Nothing Then  ' Plage "F10:F65" à modifier
    ' On fige tout
        Application.ScreenUpdating = False              ' on fige l'écran
        Application.Calculation = xlCalculationManual   ' calcul non automatique
        Application.EnableEvents = False                ' on blowue tout event
        Application.DisplayAlerts = False               ' on bloque les alertes.
    ' Prog
        Range("I10:I65").NumberFormat = "mmm yy"
        Range("F10:F65").NumberFormat = "dd mmm yy"
        For L = 10 To 65
            If Cells(L, "F") = "" Then
                Cells(L, "I") = " "
            ElseIf Cells(L, "F") < Now() Then
                Cells(L, "I") = "=DATE(YEAR(RC[-3])+VALUE(LEFT(RC[-1],1)),MONTH(RC[-3]),DAY(RC[-3]))"
            End If
        Next L
End If
    ' On remet tout
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
        Application.EnableEvents = True
        Application.DisplayAlerts = True
End Sub

 

[TooFatBoy]

Bonjour,

Une proposition :

Sub test()

    Range("i10:i65").NumberFormat = "mmm yy"
    Range("f10:f65").NumberFormat = "dd mmm yy"

    Range("I10:I65").FormulaR1C1 = "=IF(RC[-3]="""","" "",DATE(YEAR(RC[-3])+VALUE(LEFT(RC[-1],1)),MONTH(RC[-3]),DAY(RC[-3])))"

End Sub

Ca ne sert à rien de modifier toutes les cellules (ni même une seule cellule) de la plage I10:I65, ni à chaque modification de contenu d'une cellule quelconque de la feuille (ni n'importe quand d'ailleurs) vu qu'on y remet systématiquement la même chose et qu'en plus c'est une formule.

 

[sylvanu]

Bonjour TooFatBoy,
Il faut tenir compte du Cells(L, "F") < Now().

Pouvez vous fournir un petit fichier test, car telle qu'ecrite la macro est très rapide.
Si ca rame, c'est à cause d'autre chose. Il y a tellement de causes possible.

Mais peut être aura t-on un petit fichier.
Parce que telle qu'est la macro, ça ne peut pas ramer.

 

[Paillou]

Bonjour,

Merci TooFatBoy pour ta contribution.

Le fichier ne rame plus ce matin. Comprends pas ! Je vais quand même restreindre la plage de modification à certaines cellules, dans mon cas E10:E65 et G10:G65.

Merci sylvanu pour les codes supplémentaires.

Cordialement

 

[Paillou]

Mais peut être aura t-on un petit fichier.

Je suis un peu embêté de mettre le fichier. C’est un fichier médical.
Cordialement

 

[TooFatBoy]

Il faut tenir compte du Cells(L, "F") < Now().

Ah voui, j'avions zappé ça...
Du coup je propose ça :

Sub test()

    Range("i10:i65").NumberFormat = "mmm yy"
    Range("f10:f65").NumberFormat = "dd mmm yy"

    Range("I11:I65").FormulaR1C1 = "=IF(RC[-3]="""","" "",IF(RC[-3]<NOW(),DATE(YEAR(RC[-3])+VALUE(LEFT(RC[-1],1)),MONTH(RC[-3]),DAY(RC[-3])),""""))"

End Sub

Toutefois, si la formule était donc effectivement fausse, je maintiens la remarque.