Minimiser LE CODE VBA

BONJOUR

22machine.xlsm (37.43 Ko)

Je suis debutant en vba et je realise un code qui gere des machine avec date

mais il est longue

merci de votre aide

Bonsoir Richi, bonsoir le forum,

Une remarque concernant l'emplacement de ta macro : ThisWorkook. Je pense qu'elle n'est pas à sa place là. Elle devrait plutôt figurer dans un module standard. Dans l'éditeur Visual Basic (VBE, [Alt]+[F11]), menu Insertion / Module, puis tu déplaces la macro de Thisworkbook à Module1...

Le code allégé :

Sub dateGRAISSAGE()
Dim I As Byte
Dim J As Byte
Dim K As Byte

For I = 6 To 30
    For J = 6 To 16
        If K = 1 Then K = 0: J = J + 1: GoTo SUITE
        DG = Cells(I, J).Value
        If DG >= Now() + 12 Then
            Cells(I, J).Interior.Color = RGB(175, 250, 100) 'result = "Vp_OK"
        ElseIf DG > Now() And DG < Now() + 12 Then
            Cells(I, J).Interior.Color = RGB(250, 250, 175)
        Else: Cells(I, J).Interior.Color = RGB(250, 100, 100)
        End If
        K = K + 1
SUITE:
    Next J
Next I
End Sub

merci bien

sa marche très bien au colonne L.F

mais pas au colonne L.V il se concerne aussi de la condition date

17machine-v1.xlsm (36.86 Ko)

Bonsoir Richi, bonsoir le forum,

Oui désolé il y avait un bug. Voici la version corrigée :

Sub dateGRAISSAGE()
Dim I As Byte
Dim J As Byte
Dim K As Byte

Application.ScreenUpdating = fale
For I = 6 To 30
    K = 0
    For J = 3 To 43
        If K = 2 Then K = 0: GoTo SUITE
        DG = Cells(I, J).Value
        If DG >= Now() + 12 Then
            Cells(I, J).Interior.Color = RGB(175, 250, 100) 'result = "DG_OK"
        ElseIf DG > Now() And DG < Now() + 12 Then
            Cells(I, J).Interior.Color = RGB(250, 250, 175)
        Else: Cells(I, J).Interior.Color = RGB(250, 100, 100)
        End If
        K = K + 1
SUITE:
    Next J
Next I
Application.ScreenUpdating = fale
End Sub

merci

sa marche très bien

20machine-v2.xlsm (36.00 Ko)
Rechercher des sujets similaires à "minimiser code vba"