Discussion :

[counterbob]

Bonjour
j'ai réaliser ce code mais il est lent à s’exécuter, il y a-t-il moyen que l'exécution soit plus rapide.
Merci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub FormOKKO()
'sélection de la cellule H2
Range("H2").Select ' curseur sur A2
'compteur de 1 à 100 à changer jusque 1000
For compteur = 1 To 100
'insere la formule si la valeur de la cellule de gauche est égale à la date du jour
If ActiveCell.Offset(0, -1) = Date Then
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>TODAY(),""KO"",""OK"")"
' sinon si vide la valeur est vide
If ActiveCell.Offset(0, -1) = "" Then
ActiveCell = ""
End If
 
End If
ActiveCell.Offset(1, 0).Select
Next compteur
 
'sélection cellule I2
Range("I2").Select ' curseur sur A1
For compteur = 1 To 100
'si la valeur de la cellule -é de gauche = date du jour
If ActiveCell.Offset(0, -2) = Date Then
ActiveCell.FormulaR1C1 = "=IF(SUM(RC[2]:RC[14])=1,""OK"",IF(RC[-3]=1,""OK"",""KO""))"
If ActiveCell.Offset(0, -2) = "" Then
ActiveCell = ""
End If
End If
ActiveCell.Offset(1, 0).Select
Next compteur
 
End Sub

[Invité]

Bonjour,

A tester,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 
Sub FormOKKO2()
 
Dim Compteur As Integer
 
        Debug.Print Time
 
        Application.Calculation = xlCalculationManual
        'sélection de la cellule H2
        With ActiveSheet 
            'compteur de 1 à 100 à changer jusque 1000
            For Compteur = 1 To 100
                'insere la formule si la valeur de la cellule de gauche est égale à la date du jour
               With .Cells(Compteur + 1, 8)
                    Select Case .Offset(0, -1)
                           Case Date
                                .FormulaR1C1 = "=IF(RC[-1]<>TODAY(),""KO"",""OK"")"
                                .Offset(0, 1).FormulaR1C1 = "=IF(SUM(RC[2]:RC[14])=1,""OK"",IF(RC[-3]=1,""OK"",""KO""))"
                           Case ""
                                .Value = ""
                                .Offset(0, 1) = ""
                    End Select
              End With
 
            Next Compteur
 
        End With
        Application.Calculation = xlCalculationAutomatic
 
        Debug.Print Time
 
 
End Sub

[counterbob]

Bonjour,

A tester,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 
Sub FormOKKO2()
 
Dim Compteur As Integer
 
        Debug.Print Time
 
        Application.Calculation = xlCalculationManual
        'sélection de la cellule H2
        With ActiveSheet 
            'compteur de 1 à 100 à changer jusque 1000
            For Compteur = 1 To 100
                'insere la formule si la valeur de la cellule de gauche est égale à la date du jour
               With .Cells(Compteur + 1, 8)
                    Select Case .Offset(0, -1)
                           Case Date
                                .FormulaR1C1 = "=IF(RC[-1]<>TODAY(),""KO"",""OK"")"
                                .Offset(0, 1).FormulaR1C1 = "=IF(SUM(RC[2]:RC[14])=1,""OK"",IF(RC[-3]=1,""OK"",""KO""))"
                           Case ""
                                .Value = ""
                                .Offset(0, 1) = ""
                    End Select
              End With
 
            Next Compteur
 
        End With
        Application.Calculation = xlCalculationAutomatic
 
        Debug.Print Time
 
 
End Sub

Merci c'est parfait
J'ai juste modifier l'histoire de Date car en fait j'en ai pas besoin
Il fallait juste que si une cellule de la colonne G est vide les cellule des colonnes H et I soient vides sinon on met la formule.
Très rapide

Merci
@+

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub FormOKKO2()
 
Dim Compteur As Integer
 
        Debug.Print Time
 
        Application.Calculation = xlCalculationManual
        'sélection de la cellule H2
        With ActiveSheet
            'compteur de 1 à 100 à changer jusque 1000
            For Compteur = 1 To 100
                'insere la formule si la valeur de la cellule de gauche est égale à la date du jour
               With .Cells(Compteur + 1, 8)
                    Select Case .Offset(0, -1)
                           Case ""
                                .Value = ""
                                .Offset(0, 1) = ""
 
                           Case Is <> ""
                                .FormulaR1C1 = "=IF(RC[-1]<>TODAY(),""KO"",""OK"")"
                                .Offset(0, 1).FormulaR1C1 = "=IF(SUM(RC[2]:RC[14])=1,""OK"",IF(RC[-3]=1,""OK"",""KO""))"
 
                    End Select
              End With
 
            Next Compteur
 
        End With
        Application.Calculation = xlCalculationAutomatic
 
        Debug.Print Time
 
 
End Sub