Discussion :

[jgresse1025]

Bonjour,

J'ai un petit souci.

J'ai une colonne avec des cellule colorée genre: en colonne C, des lignes 9 à 12: Vert, Vert, Vert, Orange.

Je n'arrive pas à écrire le code qui me permettrait d'atteindre la dernière cellule colorée (je voudrais l'écrire du même type que celui pour atteindre la dernière ligne non vide (

Code :

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

Derligne=Range("A65536").End(xlup).Row

Je voudrais un truc du genre

Code :

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

DerCellColor=Range("??").??????

Merci d'avance pour votre aide
Julien

[antonysansh]

Bonjour Julien,

Voilà une proc qui va chercher le numero de la derniere cellule colorée dans la colonne A :

Code :

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

1
2
3
4
5
6
7
8
9
Sub test()
 
Dim i&: i = Range("A65536").End(xlUp).Row
    While Cells(i, 1).Interior.ColorIndex = xlNone
        i = i - 1
    Wend
MsgBox "La derniere cellule de la colonne A colorée se trouve en ligne : " & i
 
End Sub

[Menhir]

Code :

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

1
2
3
4
5
6
7
8
9
Sub test()
 
Dim i&: i = Range("A65536").End(xlUp).Row
    While Cells(i, 1).Interior.ColorIndex = xlNone
        i = i - 1
    Wend
MsgBox "La derniere cellule de la colonne A colorée se trouve en ligne : " & i
 
End Sub

Ca ne marchera pas forcément parce que, du point de vue de la propriété End, une cellule colorée n'est pas une cellule utilisée.
Donc, si tes dernières cellules colorées sont vides de contenues, ta macro renverra la dernière cellule ayant un contenu et non la dernière cellule colorée.

Autre prposition

Code :

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

1
2
3
4
5
6
7
8
9
10
Function LastColor() as Long
 
Dim c As Range
 
LastColor = 0
For Each c In ActiveSheet.UsedRange
   If c.Interior.ColorIndex <> xlNone Then LastColor = c.Row
Next c
 
End Sub

[antonysansh]

Tu as raison Menhir, je n'avais pas pris en compte les cellules colorées vides.

Par contre sur de très grande plage, je trouve ta solution plutôt couteuse.
Pour ma culture sais tu s'il n'est-il pas possible de parcourir depuis la fin pour éviter de passer sur des cellules colorées inutilement ?

[mercatog]

Si couleur précise, utilisez Find avec FindFormat

[gnain]

Par contre sur de très grande plage, je trouve ta solution plutôt couteuse.
Pour ma culture sais tu s'il n'est-il pas possible de parcourir depuis la fin pour éviter de passer sur des cellules colorées inutilement ?

Bonjour,
Je pense comme antonysansh, et non pas besoin de couleur précise.
en reprenant le code de antonysansh et en changant

Code :

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

Range("A65536").End(xlUp).Row

pour

Code :

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

Cells.SpecialCells(xlCellTypeLastCell).Row

et une condition pour gérer l'erreur si il n'y a aucune cellule de couleur,
et cela fonctionne même sur des cellules vides de couleurs.
on obtient

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
Sub test()
 
Dim colonne As String
colonne = "A"
 
Dim i&: i = Cells.SpecialCells(xlCellTypeLastCell).Row
 
    While Range(colonne & i).Interior.ColorIndex = xlNone
        If i = 1 Then
            'pour gérer l'erreur si il n'y a aucune cellule de couleur
            MsgBox "Aucune cellule de couleur dans la colonne " & colonne
            Exit Sub
        End If
        i = i - 1
    Wend
MsgBox "La derniere cellule de la colonne " & colonne & " colorée se trouve en ligne : " & i
 
End Sub

[patricktoulon]

Bonsoir
je ne pense pas que boucler sur le rows.count d'une feuille Excel soit le meilleur moyen

je te propose une astuce
et si je te donnais la possibilité de réduire la boucle de minimum 98%

l'astuce est simple on va repérer les cellules blanche avec specialcell(xltypecellblanks)

sauf que la faille elle est la .

comme on démarre de A dans mon exemple la plage obtenu s'arrete je donne dans le mille a la dernière cellule rempli couleur ou pas
il te reste plus qu'a boucler sur les cellules de la plage obtenu beaucoup moins grande que la colonne complète même en partant d'en bas jusqu'à la première couleur trouvée
donc dans cette (plus courte boucle )on teste si il y a une couleur ou pas et le tour est joué
voici le code
le resultat est quazi instantané

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Sub tests()
Set plageblanche = Range("a1:a" & Rows.Count).SpecialCells(xlCellTypeBlanks)
 'plageblanche.EntireRow.Hidden = true
 For Each cel In plageblanche
 If cel.Interior.Color <> 16777215 Then lig = cel.Row
  Debug.Print cel.Interior.Color
 Next
 MsgBox lig
 'plageblanche.EntireRow.Hidden = False
 End Sub

[Menhir]

Par contre sur de très grande plage, je trouve ta solution plutôt couteuse.

Effectivement, j'avais oublié que le UsedRange ne se contente pas de balayer les ligne mais qu'il va générer une plage "surfacique" englobant plusieurs colonne.

J'aurais du ajouter un Column(3) après mon UsedRange.

Pour ma culture sais tu s'il n'est-il pas possible de parcourir depuis la fin pour éviter de passer sur des cellules colorées inutilement ?

A ma connaissance, For Each ne permet pas de choisir son sens de scrutation comme For to.
Mais, si la plage utilisée fait moins de 30 000 lignes, il vaut mieux commencer par le début que par la fin.

Mais en utilisant un SpecialCells(xlCellTypeLastCell) (comme le suggère gnain), ça permet de commencer plus près de la cible.
Ce code devrait être plus rapide que le premier que j'ai donné.

Code :

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

1
2
3
4
5
6
7
Function LastColor() as Long
 
For LastColor = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
   If Cells(LastColor, 3).Interior.ColorIndex <> xlNone Then Exit For
Next LastColor
 
End Function

[gnain]

Bonjour,
effectivement, il est mieux de partir d'en bas que d'en haut.
puis on est pas obligé d'utiliser UsedRange car xlCellTypeLastCell va chercher la dernière ligne utilisé.

Code :

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

1
2
3
4
5
6
7
8
For LastColor = Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
   If Cells(LastColor, 5).Interior.ColorIndex <> xlNone Then
        lig = LastColor
        Exit For
    End If
 
Next LastColor
MsgBox lig

[patricktoulon]

re et Bonjour

avez vous essayer ma proposition ??

speciall(xltypelastcelll) .row te donne le row.count de la plage utilisées dans cet exercice ici de la colonne A
moi en plus je te propose que la boucle ne prenne pas en compte les cellules blanche

dans mon exemple j'ai bloquer 2 lignes qui masque et affiche les ou les cellule sont vide et blanches
si tu les débloques tu verra en visuel le travail que fait specialcell(xltypecellblanks)

les premiers cellules qui resteront apparentes sont les cellules qui contiennent quelque chose ou la dernière couleur c'est pas compliqué

car le speciall(xltypelastcell) t'arete au rangeused de la colonne A y compris les cellules blanches qui sont a l'intérieur
le xltypecellblanks prend en compte que les cellules vraiment utilisées sans les celles blanches

regarde encore ma proposition tu comprendra

[jgresse1025]

J'ai reussi à trouver un moyen de contourner mon problème

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
 
Derligne = Sheets("Suivi").Range("A65536").End(xlUp).Row
c = 0
For d = Derligne To 9 Step -1
If Cells(d, 3).Interior.ColorIndex = xlColorIndexNone Then
c = c + 1
End If
Next d
 
If Cells(Derligne - c, 3).Interior.ColorIndex = 46 Then
    If Cells(Derligne - c, 3).Value = "En attente" Then
    Prog = (Cells(Derligne - c, 1).Value - 1) * 100 / S
    'MsgBox (Prog)
    Else
    Prog = (Cells((Derligne - c) - 1, 1).Value) * 100 / S
    'MsgBox (Prog)
    End If
End If

[mercatog]

Find avec FindFormat

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
Dim LastLig As Long
Dim c As Range
 
With Worksheets("Suivi")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    Application.FindFormat.Interior.ColorIndex = 46
    Set c = .Range("C1").Resize(LastLig).Find("", SearchDirection:=xlPrevious, SearchFormat:=True)
    Application.FindFormat.Clear
    If Not c Is Nothing Then
        If c = "En attente" Then
            Prog = (c.Offset(, -2) - 1) * 100 / S
        Else
            Prog = c.Offset(-1, -2) * 100 / S
        End If
    End If
End With

[gnain]

Bonjour,
Si c'était pour une couleur précise alors, c'est vrai, on ne peut pas trouvé mieux que la proposition de mercatog avec FindFormat. +1

[patricktoulon]

Re

et si la couleur n'est pas defini

alors je réitère ma méthode avec un code plus élaboré et surtout commenté pour que tout le monde comprenne pourquoi j'utilise un argument qui finalement n'a rien a voir a la demande et pourtant SI!!!!
résultat quazi instantané
regarder bien les commentaire et voir même les résultats dans le debug
ayant laisser les lignes debug.print il vous sera facile de voir le cheminement de la macro
ca fait beaucoup de lignes de commentaires je sais mais c'était important de donner ces explications
le msgbox t'affiche a la fin l'adresse de la cellules recherché

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
Sub test2()
    Dim TheNextcell As Range, plageblanche As Range, i As Long, nextligne As Long
    With Sheets(1)
        'on récupère la plage de cellule vide par le .SpecialCells(xlCellTypeBlanks)
        'meme si on choisi toute les cellules de la colonne A par le .Range("a1:a" & Rows.Count)
        'la fonction s'arrete a la derniere cellule (rempli ,ou colorée , ou les deux) c'est la faille dont je parlais vous pouvez le constater dans le debug
        ' j'ai préféré utiliser l'argument xlCellTypeBlanks car xlCellTypeLastCell donne la derniere ligne ecrite
        'tandis que xlCellTypeBlanks donne la derniere ligne ecrite et/ou colorée
 
        Set plageblanche = .Range("a1:a" & Rows.Count).SpecialCells(xlCellTypeBlanks)
        Debug.Print plageblanche.Address    ' voir l'adresse des areas discontigues de la  plage dispo dans le debug
        'maintenant on récupère la derniere ligne de cette plage discontigues
        nbligne = Split(plageblanche.Address, "$")    'on coupe les adresse dicontigues par les symboles "$"
        nextligne = Fix(nbligne(UBound(nbligne))) + 1    'la derniere ligne= le dernier chiffre +1
        Debug.Print nextligne    ' voir le Numero de ligne  dans le debug
        'maintenant que l'on a la derniere ligne ecrite et/ou avec une couleur de la colonne A on la teste si elle est colorée on ira pas plus loin (pas la boucle qui suit)
        Debug.Print Cells(nextligne, 1).Interior.Color
        If .Cells(nextligne, 1).Interior.Color <> 16777215 Then
            Set TheNextcell = .Cells(nextligne, 1)
           Debug.Print "la derniere cellule colorée de la colonne A est   " & Cells(nextligne, 1).Address
        Else
            'si la derniere cellule de la plage dispo n'est pas colorée alors
            'on fait une toute petite boucle pour remonter jusque a la premiere cellule colorée precedent la nextligne
            'dans n'imorte quelle cas la boucle s'arretera a la premiere couleur en partant d'en bas DE LA PLAGE DISPO!!!!!
            For i = nextligne To 1 Step -1
                Debug.Print i & "   " & Cells(nextligne, 1).Interior.Color
                If .Cells(i, 1).Interior.Color <> 16777215 Then Set TheNextcell = .Cells(i, 1): Exit For
            Next i
        End If
    End With
MsgBox TheNextcell.Address
End Sub

[davido84]

Bonsoir,
Patrick : juste pour te signaler que cela ne semble pas fonctionner dans le cas présent

Je n'ai pas suivi le fil mais il me semble que c'est la dernière cellule colorée que tu cherches à cibler et ce qu'elle contienne ou non une valeur, est-ce bien cela ?
A+

[davido84]

Visiblement quand les 2 dernières cellules contiennent des valeurs et que la dernière est colorée il y a un problème...
Peut-être une idée à explorer en stockant les valeurs de la colonne A dans une plage temporaire de manière à exploiter ton idée d'utiliser SpecialCells(xlCellTypeBlanks) sur une plage vide afin de ramener la dernière cellule colorée puis de réinjecter les données à la fin :

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
Sub DerCelColoree()
 
Dim InitPlg As Range, CCPlg As Range, temp, DerCelCoul As Range
 
 
Set InitPlg = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
temp = InitPlg.Value
InitPlg.ClearContents
 
 
Set CCPlg = Columns(1).SpecialCells(xlCellTypeBlanks)
Set DerCelCoul = Cells(CCPlg.Rows.Count, 1)
 
 
For i = CCPlg.Rows.Count To 1 Step -1
  If Cells(i, 1).Interior.Color <> 16777215 Then Set DerCelCoul = Cells(i, 1): Exit For
Next i
 
 
InitPlg = temp
MsgBox DerCelCoul.Address
 
 
End Sub

A tester plus avant si l'idée te paraît intéressante.

A+

[patricktoulon]

pour eviter tout mal entendu
j'ouvre un nouveau fichier vierge je met ma macro dans un module standard
le colori enjaune la A12,25,33
jemet uneconstante dans A 8,12et 32 c'est bien ca ??????? resultat


Davido je te donne un indice (+1)

a part ca

je ne sais pas comment tu a essayé ma macro mais tu devrais ouvrir un fichier vierge de toutes modification antérieurs avant



je vais essayer la tienne pour voir si j'ai raison de ce que je crois e ne me trompe pas

ca n'est pas pour rien que j'ai laissé les debug.print

je viens d'essayer avec la 33 écrite et effectivement on pert celle la et c'est normal pudique le xltypeblanks s'arrête a l'avant dernière
mais par rapport a ta capture c'est bizare ca ne devrait pas
alors j'ai modifié comme ceci va

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 test2()
    Dim TheNextcell As Range, plageblanche As Range, i As Long, nextligne As Long
    With Sheets(1)
        'on récupère la plage de cellule vide par le .SpecialCells(xlCellTypeBlanks)
        'meme si on choisi toute les cellules de la colonne A par le .Range("a1:a" & Rows.Count)
        'la fonction s'arrete a la derniere cellule (rempli ,ou colorée , ou les deux) c'est la faille dont je parlais vous pouvez le constater dans le debug
        ' j'ai préféré utiliser l'argument xlCellTypeBlanks car xlCellTypeLastCell donne la derniere ligne ecrite
        'tandis que xlCellTypeBlanks donne la derniere ligne ecrite et/ou colorée
 
        Set plageblanche = .Range("a1:a" & Rows.Count).SpecialCells(xlCellTypeBlanks)
        Set plageconst = .Range("a1:a" & Rows.Count).SpecialCells(xlCellTypeConstants)
        Set plagetotal = Union(plageblanche, plageconst)
        Debug.Print plagetotal.Address    ' voir l'adresse des areas discontigues de la  plage dispo dans le debug
        'maintenant on récupère la derniere ligne de cette plage discontigues
        nbligne = Split(plagetotal.Address, "$")    'on coupe les adresse dicontigues par les symboles "$"
        nextligne = Fix(nbligne(UBound(nbligne))) + 1    'la derniere ligne= le dernier chiffre +1
        Debug.Print nextligne    ' voir le Numero de ligne  dans le debug
        'maintenant que l'on a la derniere ligne ecrite et/ou avec une couleur de la colonne A on la teste si elle est colorée on ira pas plus loin (pas la boucle qui suit)
        Debug.Print Cells(nextligne, 1).Interior.Color
        If .Cells(nextligne, 1).Interior.Color <> 16777215 Then
            Set TheNextcell = .Cells(nextligne, 1)
           Debug.Print "la derniere cellule colorée de la colonne A est   " & Cells(nextligne, 1).Address
        Else
            'si la derniere cellule de la plage dispo n'est pas colorée alors
            'on fait une toute petite boucle pour remonter jusque a la premiere cellule colorée precedent la nextligne
            'dans n'imorte quelle cas la boucle s'arretera a la premiere couleur en partant d'en bas DE LA PLAGE DISPO!!!!!
            For i = nextligne To 1 Step -1
                Debug.Print i & "   " & Cells(nextligne, 1).Interior.Color
                If .Cells(i, 1).Interior.Color <> 16777215 Then Set TheNextcell = .Cells(i, 1): Exit For
            Next i
        End If
    End With
MsgBox TheNextcell.Address
End Sub

oups!!! j'avais pas vu la 33 ecrite sur ta capture autant pour moi de toute façon celle la fonctionne

pour que ca soit plus clair
debug 33 vide/pleine

$A$1:$A$7,$A$9:$A$11,$A$13:$A$31,$A$33 'plageblanche.address avec la 33 vide et jaune
$A$8,$A$12,$A$32 'plageconst.address avec la 33 vide et jaune
$A$1:$A$33 'plagetotal.address avec la 33 vide et jaune


$A$1:$A$7,$A$9:$A$11,$A$13:$A$31 'plageblanche.address avec la 33 pleine et jaune
$A$8,$A$12,$A$32:$A$33 'plageconst.address avec la 33 pleine et jaune
$A$1:$A$33 'plagetotal.address avec la 33 pleine et jaune

re
pour finir j'adapte mon principe a ton code

j'ai supprimer le passage ou on clear les cellules pour les remettre apres car un tableau remets les valeurs pas les formules (et oui y faut y penser )

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub DerCelColoree()
    Dim InitPlg As Range, CCPlg As Range, temp, DerCelCoul As Range
    Set InitPlg = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
    'temp = InitPlg.Value
    'InitPlg.ClearContents
    Set CCPlg = Columns(1).SpecialCells(xlCellTypeBlanks)
    Set CCPlg = Union(InitPlg, CCPlg)
    Set DerCelCoul = Cells(CCPlg.Rows.Count, 1)
    For i = CCPlg.Rows.Count To 1 Step -1
        If Cells(i, 1).Interior.Color <> 16777215 Then Set DerCelCoul = Cells(i, 1): Exit For
    Next i
    'InitPlg = temp
    MsgBox DerCelCoul.Address
End Sub

[davido84]

j'ai supprimer le passage ou on clear les cellules pour les remettre apres car un tableau remets les valeurs pas les formules (et oui y faut y penser )

Testé vite fait donc à tester plus sérieusement mais sur mon code retouché cela semble (je dis bien semble) fonctionner.
Par contre sur ton test si la dernière cellule colorée comporte une formule elle n'est pas prise en compte.


A+

[patricktoulon]

Testé vite fait donc à tester plus sérieusement mais sur mon code retouché cela semble (je dis bien semble) fonctionner.
Par contre sur ton test si la dernière cellule colorée comporte une formule elle n'est pas prise en compte.


A+

c'est normal on ne prend pas les cellules avec formules du moins pas directement
on prend que les cellules colorée donnée par xltypeblanks(vide et couleur )et les xlconstants(couleur ou pas )
donc si il y a des formules dans les cellules colorée on les prend sinon non
si il y a des cellules après la dernière de l'union des blanks et constants forcement elle ne sera pas pris en compte

si on ajoute les formule ca remet en question l'utilisation de la faille de la fonction XltypeBlanks

tout du moins ca augmente considérablement la plage hors j'utilise cette faille justement pour éviter le plage.rows.count
ca reviendrait a utiliser le .end(xlup).row en cas de grande plage ma fonction serait considérablement ralenti
mais bon allons y ajoutons les formules il y aura toujours quelque cellule en moins

et finalement si une telle fonction est nécessaire après tout une boucle sur le bas to le haut qui s'arrêterait des la première couleur serait ma fois pas une sinécure

c'était juste pour l'exercice de l'utilisation de la FAILLE de xltypeBlanks
et quand je dis faille en fait ca n'est pas exact en fait après renseignement il s'agirait d'une limitation programmée de la fonction afin d'éviter d'avoir un rows.count
en effet si il y avait pas cette limite la dernière cellule de la plage xltypeBlanks serait le rows.count

au fait a tu essayé la méthode de Mercatog
je m'y suis intéressé mais je n'ai absolument pas de résultat (rien du tout)
c'est dommage finalement on aurait pu faire la même chose dans une boucle sur 56 couleur index de excel en testant le row et en gardant le plus grand
mais chez moi je n'est absolument rien

[davido84]

au fait a tu essayé la méthode de Mercatog
je m'y suis intéressé mais je n'ai absolument pas de résultat (rien du tout)

Je l'ai testé vite fait et je n'ai aucun résultat également.
A+