Discussion :

[Leilou65]

Bonjour le forum,

J'ai déjà posté une discussion sur ce sujet mais la il y a une variable en plus à prendre en compte.

En fait la macro me permet de sélectionner des donnée en fonction de leur somme et de colorer le tout.
Voila donc ce que la macro fait je lui demande de sélectionner des lignes ayant un total > à 10 :


Sauf que moi je voudrai qu'elle me sélectionne des lignes ayant le total > à 10 mais aussi il faut qu'un des nombre à l'intérieur soit négatif et donc je souhaite avoir comme résultat :



Voici le code :

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
Sub Bouton1_Cliquer()
 
    Dim Cell As Range
    Dim val1 As Long
 
    val1 = 10
    irow = Cells(Rows.Count, 3).End(xlUp).Row
 
    For Each Cell In Worksheets("Feuil1").Range("N2:N" & irow)
        If Cell.HasFormula And InStr(1, Cell.Formula, "SOUS.TOTAL", vbTextCompare) = 0 And Cell.Value > val1 Then
            Range(Cell.Offset(0, -13), Cell).Interior.ColorIndex = 6
 
        For ligne = Cell.Row - 1 To 1 Step -1
            If Cells(ligne, 14).Value < 0 Then
                Range(Cells(ligne, 1), Cells(ligne, 14)).Interior.ColorIndex = 6
            Else
                ligne = 1
            End If
        Next
        End If
    Next
End Sub

Merci à vous tous pour votre aide

[riaolle]

Bonjour,
Du coup, quelle est ta question? Il faut juste que tu ajoutes une condition à ton If, non?
Par curiosité : pourquoi effectues-ti ta boucle For (ligne) à l'envers?

[Al__22]

Si j'ai bien compris :

- Tu parcours tes lignes pour vérifier les totaux
- Tu vérifie que tes totaux sont supérieur à 10, si c'est le cas tu colorie sinon non

Jusque la tout va

Ensuite :

- Il faut qu'une ligne amenant au total soit inférieur à 0 (ou négatif si tu préfères) pour que tu colorie le total ainsi que toute les lignes si référant

Pour ce faire :

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
Dim Cell As Range
    Dim val1 As Long
    Dim i As Integer, x As Integer
    Dim negatif as Boolean
 
    x = 1
    val1 = 10
    irow = Cells(Rows.Count, 3).End(xlUp).Row
 
With Worksheets("Feuil1") 'Avec ta feuille 1
  For i = 1 to irow 'De la ligne 1 à la dernière non vide
    If .Range("C" & i).Value Like "*Total*" And .Range("N" & i).Value > val1 then 'Si on est sur un Total et que celui-ci est > à  val1
      For Each Cell in .Range(.Cells(x,14), .Cells(i - 1,14)) 'Pour chaque cellule formant ton total
        If Cell.value < 0 Then negatif = True: Exit For 'Si une cellule est négative, alors negatif est vrai
      Next
      If negatif = True Then 'Si negatif est vrai
        .Range(.Cells(x, 1), .Cells(i, 14)).Interior.ColorIndex = 6 'Tu colorie tout ton total
        negatif = false 'Remets negatif en faux
      End if
      x = i + 1 'Donne à x la valeur de i + 1 pour le prochain range de total
    Elseif .Range("C" & i).Value Like "*Total*" 'Si tu es sur un total mais qu'il n'est pas supérieur à 10
      x = i + 1 'Donne à x la valeur de i + 1 pour le prochain range de total
    End if
  Next
End With

Je ne l'ai pas essayé mais ça devrait marcher , j'ai normalement mis suffisamment d'explications dedans, sinon n’hésites pas

[Marc-L]

Bonjour, bonjour !

Voici le code :

Mais quelle horreur ce code !     Que de boucles inutiles et lentes !
Je t'ai pourtant fourni un code efficace dans ta discussion précédente dans lequel il suffit pourtant juste d'utiliser le B-A-BA d'Excel,
à savoir ajouter une simple formule de calculs évitant ainsi encore une boucle !

Donc à partir du code de la discussion précédente :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Demo2()
       Const C = 12, S = 10
         Dim Rg As Range, Rf As Range
         Set Rg = Feuil1.Cells(3)
    Do Until Rg.Value = ""
         Set Rf = Feuil1.Columns(3).Find("Total ", Rg, xlValues, xlPart)
          If Rf(1, C).Value > S Then
              If Application.CountIf(Range(Rg(1, C), Rf(0, C)), "<0") Then Range(Rg(1, -1), Rf(1, C)).Interior.ColorIndex = 6
          End If
         Set Rg = Rf(2)
    Loop
         Set Rg = Nothing:  Set Rf = Nothing
End Sub

Voilà, voilà !

___________________________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

___________________________________________________________________________________________________________

Je suis Paris, London, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

[Docmarti]

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
 
Sub Bouton1_Cliquer()
 
    Set f = Worksheets("Feuil1")
    f.Cells.Interior.ColorIndex = 0
    Dim Cell As Range
    Dim val1 As Long
 
    val1 = 10
    irow = f.Cells(f.Rows.Count, 3).End(xlUp).Row
    ligne = 2
    negatif = False
    For Each Cell In f.Range("N2:N" & irow)
 
        f.Range(Cell.Offset(0, -13), Cell).Interior.ColorIndex = 0
 
        If Cell.Value < 0 Then
            If InStr(1, Cell.FormulaLocal, "SOUS.TOTAL", vbTextCompare) = 0 Then
                negatif = True
            End If
 
        End If
 
        If Cell.HasFormula And InStr(1, Cell.FormulaLocal, "SOUS.TOTAL", vbTextCompare) > 0 And Cell.Value > val1 Then
 
            Set c = Cell
 
            While negatif = True And c.Row >= ligne
 
                f.Range(c.Offset(0, -13), c).Interior.ColorIndex = 6
 
                Set c = c.Offset(-1)
 
            Wend
            negatif = False
            ligne = Cell.Row + 1
 
        End If
    Next
End Sub

[Leilou65]

Merci Marc avec ton code qui marche très bien mais le problème c'est que la macro je l'enregistre sur un fichier 0 et je l'exécute pour modifier un fichier 1.

J'ai donc fais comme tu m'a dis avec un Workbooks("Fichier1.xls").Worksheets("Feuil1").Activate
Mais j'ai une erreur d'exécution 9 : l'indice n'appartient pas à la sélection.
Je ne sais pas à quoi cela correspond.

Merci à vous tous pour le temps que vous m'avez accordé.

[Marc-L]

Ajout de la référence de la feuille externe en ligne n°4 + modification des lignes 5 & 7 :

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
Sub Demo2()
       Const C = 12, S = 10
         Dim Rg As Range, Rf As Range
    With Workbooks("Fichier1.xls").Worksheets("Feuil1").Columns(3)
         Set Rg = .Cells(1)
    Do Until Rg.Value = ""
         Set Rf = .Find("Total ", Rg, xlValues, xlPart)
          If Rf(1, C).Value > S Then
              If Application.CountIf(Range(Rg(1, C), Rf(0, C)), "<0") Then Range(Rg(1, -1), Rf(1, C)).Interior.ColorIndex = 6
          End If
         Set Rg = Rf(2)
    Loop
         Set Rg = Nothing:  Set Rf = Nothing
    End With
End Sub

Faut-il encore les noms du classeur et de la feuille soient corrects …

_________________________________________________________________________________________________________

    Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[Leilou65]

J'ai ajouté la référence de la feuille externe en ligne 4 et modifié les lignes 5 & 7 avec les noms du classeur et de la feuille exactes mais j'ai toujours ce même message d'erreur d'exécution 9 : l'indice n'appartient pas à la sélection.

J'ai fait un test en recopiant le même code sur le classeur Fichier1.xls et là le code marche parfaitement.

Je ne comprend pas pourquoi il ne fonctionne pas à partir d'un autre classeur alors que le nom du fichier où doit s'exécuter la macro est parfaitement pris en compte dans le code.