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.

[Marc-L]

et modifié les lignes 5 & 7 avec les noms du classeur et de la feuille exactes

Il n'y a aucune référence dans les lignes 5 & 7 de mon code !   Car juste le point suffit …

Quelle ligne déclenche l'erreur ?
Si c'est la n°4 alors c'est juste une erreur dans le nom du classeur ou de la feuille …

[Docmarti]

Publie ton nouveau code qui fonctionne.

[Leilou65]

Voici le code qui fonctionne sur le classeur 031086.xls dans la feuille "Quid" :

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
Sub Demo2()
       Const C = 12, S = 10
         Dim Rg As Range, Rf As Range
 
    With Workbooks("031086.xls").Worksheets("Quid").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

L'erreur apparait à la ligne n°5 quand j'enregistre le code sur un autre classeur.

[riaolle]

Bonjour,
Le classeur 031086.xls est-il ouvert lorsque tu lances la macro?

[Leilou65]

Oui il est ouvert.

[Leilou65]

J'ai fais plusieurs tests afin de comprendre ou le probleme se situe mais je n'ai pas trouvé.
Du coup j'ai mis le nom du classeur en variable et bizarrement la macro marche :

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
Sub Demo2()
    Const C = 12, S = 10
    Dim Rg As Range, Rf As Range
 
    classeur = "031086"
    Workbooks(classeur & ".xls").Worksheets("Quid").Activate 'Fichier sélectionné activé
 
    With Workbooks(classeur & ".xls").Worksheets("Quid").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

Donc pour l'instant ça me va mais si quelquun sait pourquoi le code n'accepte pas : Workbooks("031086.xls").Worksheets("Quid").

Merci pour votre aide

[Leilou65]

Ah je viens de comprendre bon j'aurais pas les bons thermes je pense.
Alors la macro fonctionne (que le nom du classeur soit une variable ou pas) quand les deux classeurs sont dans le même "fichier" (on peut par exemple afficher les deux classeur cote à cote).
Par contre si les deux classeurs sont ouvert dans deux "fichiers" différents là la macro ne fonctionne pas.

C'est peut être une question bête mais est ce normal et si oui peut on ajouter des lignes au code pour contourner cela ?

Encore merci à vous.

[Marc-L]

La ligne n°8 rend la ligne n°6 inutile logiquement :  essayer déjà en mettant cette ligne n°6 en commentaire.

Il est idiot d'ouvrir deux instances d'Excel (gâchis de ressources) !
Donc évidemment en ouvrant les classeurs dans une seule et même instance, il n'y a pas de souci …

[Leilou65]

Oui du coup en mettant la ligne n° 6 en commentaire la macro fonctionne.
Mais comme la dernière fois elle fonctionne quand les deux classeurs sont réunis dans le même fichier Excel mais ne fonctionne pas quand les deux classeurs sont sur deux fichiers Excel différents.

Version Excel 2010 le fichier ou se trouve la macro enregistré en format .xlsm et le fichier ou la macro agit enregistré au format .xls (je ne sais pas si cela rentre en compte).

[Leilou65]

Idiot ou pas c'est une chose que certains utilisateurs pourraient faire

Merci en tout cas pour ta réactivité.

[Marc-L]

Un bip retentit si le classeur n'est pas ouvert (dans la même instance) :

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
Sub Demo2a()
       Const C = 12, S = 10, CLASSEUR = "Fichier1.xls", FEUILLE = "Feuil1"
         Dim Rg As Range, Rf As Range
         If IsError(Evaluate("ISREF('[" & CLASSEUR & "]" & FEUILLE & "'!A1)")) Then Beep: Exit Sub
    With Workbooks(CLASSEUR).Worksheets(FEUILLE).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

Imagine le ralentissement de Windows, voir carrément son plantage,
si chaque classeur ouvert se trouve dans une instance séparée par exemple pour une vingtaine de classeurs !

[Leilou65]

Apres vous avez raison car en général quand une personne souhaite ouvrir un classeur il s'ouvre directement dans l'instance ou se trouve déjà les autres classeurs.