XL 2016 VBA Simplifier une formule

Paillou

XLDnaute Nouveau
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

XLDnaute Barbatruc
Supporter XLD
Bonsoir paillou,
Une possibilité :
VB:
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 :
VB:
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 )
 
Dernière édition:

Paillou

XLDnaute Nouveau
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

XLDnaute Barbatruc
Supporter XLD
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 :
VB:
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

XLDnaute Barbatruc
Supporter XLD
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.
VB:
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
 
Dernière édition:

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Une proposition :
VB:
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. ;)
 
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
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

XLDnaute Nouveau
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
 

TooFatBoy

XLDnaute Barbatruc
Il faut tenir compte du Cells(L, "F") < Now().
Ah voui, j'avions zappé ça... :(
Du coup je propose ça :
VB:
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.
 
Dernière édition:

Discussions similaires

Réponses
14
Affichages
621
Réponses
17
Affichages
866

Statistiques des forums

Discussions
311 722
Messages
2 081 930
Membres
101 843
dernier inscrit
Thaly