Discussion :

[xszma]

Bonjour !

Sur une macro que je retravaille, il y a un bout de code dont je ne comprend pas le sens ni l'utilité, une âme charitable pour me le faire comprendre ou bien encore me l'optimiser ?
Voici la boucle en question :

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
35
36
37
38
39
40
41
42
 
i = 1
J = 1
 
    Do While Cells(i, J) <> "DISPONIBLE"
        If J < 10 Then
        J = J + 1
        Else
        J = 1
        i = i + 1
        End If
    Loop
 
 
    Do While Cells(i, J) <> ""
        If Left(Cells(i, 1), 5) <> "Total" Then
            If Cells(i, J).Value < 0 Then
 
                Cells(i, J).Select
 
                With Selection.Interior
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
 
                End With
 
            Else
 
                Cells(i, J).Select
 
                With Selection.Interior
                    .Pattern = xlNone
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
 
                End With
 
 
            End If
        End If
        i = i + 1
    Loop

Merci d'avance !

[marot_r]

Bonjour.

À mon avis c'est cela :

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
35
36
37
38
39
40
41
42
43
44
45
46
 
i = 1
J = 1
 
    '=== Cherche la première cellule qui ne contient pas le mot "DISPONIBLE" dans les colonnes A à I.
    Do While Cells(i, J) <> "DISPONIBLE"
        If J < 10 Then
             J = J + 1
        Else
            J = 1
            i = i + 1
        End If
    Loop
    '--- Cherche la première cellule qui ne contient pas le mot "DISPONIBLE" dans les colonnes A à I.
 
    '=== Formate les cellules de la colonne de la première cellule qui ne contient pas le mot "DISPONIBLE" jusqu'à la 1ère qui est vide
    ' En partant de la première cellule qui ne contient pas le mot "DISPONIBLE"
    Do While Cells(i, J) <> ""
        If Left(Cells(i, 1), 5) <> "Total" Then
            If Cells(i, J).Value < 0 Then
 
                Cells(i, J).Select
 
                With Selection.Interior
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
 
                End With
 
            Else
 
                Cells(i, J).Select
 
                With Selection.Interior
                    .Pattern = xlNone
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
 
                End With
 
 
            End If
        End If
        i = i + 1
    Loop
    '--- Formate les cellules de la colonne de la première cellule qui ne contient pas le mot "DISPONIBLE" jusqu'à la 1ère qui est vide

A+

[halaster08]

Bonjour,

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
35
36
37
38
39
40
41
42
43
44
45
 
i = 1
J = 1
 
    Do While Cells(i, J) <> "DISPONIBLE"
        If J < 10 Then
        J = J + 1
        Else
        J = 1
        i = i + 1
        End If
    Loop
  ' boucle ligne par ligne sur 10 colonnes, s'arrête dès quelle ne trouve pas le mot "disponible" dans une cellule
'optimisation possible: utiliser la méthode find  
 
' a partir de là le J ne bouge plus et représente la colonne où on a trouve le mot "disponible"
    Do While Cells(i, J) <> "" 'boucle sur les cellules de la colonne J tant qu'on ne pas une cellule vide
        If Left(Cells(i, 1), 5) <> "Total" Then si les premiers caractère de la première colonne ne sont pas "Total"
            If Cells(i, J).Value < 0 Then 'si la valeur de la cellule est négative
 
                Cells(i, J).Select 'on sélectionne (inutile)
 
                With Selection.Interior
                    .PatternColorIndex = xlAutomatic 'puis on colorie
                    .Color = 255 'optimisation: se passer de la sélection
 
                End With
 
            Else 'sinon
 
                Cells(i, J).Select 'on sélectionne (inutile)
 
 
                With Selection.Interior 'puis on colorie d'un autre manière
                    .Pattern = xlNone 'optimisation: se passer de la sélection
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
 
                End With
 
 
            End If
        End If
        i = i + 1
    Loop

[Menhir]

La première boucle cherche le mot "Indisponible" dans les colonnes A:J.
La seconde boucle cherche le mot "Total" dans la colonne A des lignes suivantes jusqu'à la première ligne vide.
Pour chaque ligne, si la cellule de la colonne où se trouvait "Indisponible" est négative, on la mets en rouge. Sinon, on supprime son motif.

[xszma]

Merci de vos réponses claires rapides!

halaster08, tu peut me dire comment utiliser la méthode find sur le mot "DISPONIBLE", ce ne serait pas plutôt sur la cellule directement ?
Quant à la selection je doit réecrire mon code de cette manière ?

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
 
Do While Cells(i, j) <> ""
        If Left(Cells(i, 1), 5) <> "Total" Then
            If Cells(i, j).Value < 0 Then
 
                With Selection.Interior
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
 
                End With
 
            Else
 
                With Selection.Interior
                    .Pattern = xlNone
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
 
                End With

Merci beaucoup

[Menhir]

Comme ça va plus vide de l'écrire que de l'expliquer :

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
Dim RSel As Range, Cur As Range
 
Set RSel = Columns("A:J").Find("DISPONIBLE")
If Not RSel Is Nothing Then
    For Each Cur In Range(RSel, RSel.End(xlDown))
        If Left(Cur.Row, 5) <> "Total" Then
            If Cur.Value < 0 Then
                Cur.Interior.PatternColorIndex = xlAutomatic
                Cur.Interior.Color = 255
            Else
                Cur.Interior.Pattern = xlNone
                Cur.Interior.TintAndShade = 0
                Cur.Interior.PatternTintAndShade = 0
            End If
        End If
    Next Cur
End If

C'est du code tapé à l'arrache directement sur le forum. Tu auras donc peut-être du débugage à faire.

Cela dit, perso, j'aurai fait ça avec deux MFC plutôt qu'avec une macro.