Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Trouver Cellule de couleur

Trouver Cellule de couleur

6 réponses
Avatar
Ghyslain
Bonjour a tous,
j'ai la macro suivante qui s"execute a l'aide de ctrl + tab

Dim nblig&
Dim R As Range
Dim C As Range
Set R = ActiveSheet.UsedRange
nblig& = R.Row + R.Rows.Count - 1
Set R = Range("a" & Selection.Row + 1 _
& ":a" & nblig& & "")
For Each C In R
If C.Interior.ColorIndex = 36 Then
If Rows(C.Row).Interior.ColorIndex = 36 Then
C.Select
Exit For
End If
End If
Next C
********************************************

Mais j'aimerai bien qu'il remonte a la premiere cellule jaune lorsque il en
trouve plus .... donc qu'il recommence au debut quand il a fini de les
trouver la il arrete ce qui est normal car il en voi plus d'autre.
Y a t-il une facons de le faire recommencer ou de mettre un msgbox qui dit
aucune autre ligne de couleur jaune trouver et qui recommence du debut apres
sa ??

Merci de votre aide
Signaler un problème avec ce contenu

6 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
isabelle
bonjour Ghyslain,

Sub macro1()
Dim nblig&
Dim R As Range
Dim C As Range
Set R = ActiveSheet.UsedRange
nblig& = R.Row + R.Rows.Count - 1
Set R = Range("a" & Selection.Row + 1 _
& ":a" & nblig& & "")
debut:
For Each C In R
If C.Interior.ColorIndex = 36 Then
If Rows(C.Row).Interior.ColorIndex = 36 Then
C.Select
x = x + 1
If x = 1 Then Set xx = ActiveCell
Exit For
End If
End If
Next C
xx.Select
End Sub

isabelle

Bonjour a tous,
j'ai la macro suivante qui s"execute a l'aide de ctrl + tab

Dim nblig&
Dim R As Range
Dim C As Range
Set R = ActiveSheet.UsedRange
nblig& = R.Row + R.Rows.Count - 1
Set R = Range("a" & Selection.Row + 1 _
& ":a" & nblig& & "")
For Each C In R
If C.Interior.ColorIndex = 36 Then
If Rows(C.Row).Interior.ColorIndex = 36 Then
C.Select
Exit For
End If
End If
Next C
********************************************

Mais j'aimerai bien qu'il remonte a la premiere cellule jaune lorsque il en
trouve plus .... donc qu'il recommence au debut quand il a fini de les
trouver la il arrete ce qui est normal car il en voi plus d'autre.
Y a t-il une facons de le faire recommencer ou de mettre un msgbox qui dit
aucune autre ligne de couleur jaune trouver et qui recommence du debut apres
sa ??

Merci de votre aide




Avatar
docm
Bonjour.
Voici une facon de remonter s'il ne trouve pas.

Dim nblig&
Dim R As Range
Dim C As Range
Set R = ActiveSheet.UsedRange
nblig& = R.Row + R.Rows.Count - 1
Set R = Range("a" & Selection.Row + 1 _
& ":a" & nblig& & "")
While Ok < 2
Ok = Ok + 1
For Each C In R
If C.Interior.ColorIndex = 36 Then
If Rows(C.Row).Interior.ColorIndex = 36 Then
C.Select
Ok = 2
Exit For
End If
End If
Next C
Set R = ActiveSheet.UsedRange
Set R = Range("a" & R.Row _
& ":a" & nblig& & "")
Wend

docm

"Ghyslain" a écrit dans le message news:

Bonjour a tous,
j'ai la macro suivante qui s"execute a l'aide de ctrl + tab

Dim nblig&
Dim R As Range
Dim C As Range
Set R = ActiveSheet.UsedRange
nblig& = R.Row + R.Rows.Count - 1
Set R = Range("a" & Selection.Row + 1 _
& ":a" & nblig& & "")
For Each C In R
If C.Interior.ColorIndex = 36 Then
If Rows(C.Row).Interior.ColorIndex = 36 Then
C.Select
Exit For
End If
End If
Next C
********************************************

Mais j'aimerai bien qu'il remonte a la premiere cellule jaune lorsque il
en

trouve plus .... donc qu'il recommence au debut quand il a fini de les
trouver la il arrete ce qui est normal car il en voi plus d'autre.
Y a t-il une facons de le faire recommencer ou de mettre un msgbox qui dit
aucune autre ligne de couleur jaune trouver et qui recommence du debut
apres

sa ??

Merci de votre aide




Avatar
michdenis
Bonjour Ghyslain,

Voici une alternative intéressante pour trouver et boucler sur un format de cellule particulier. Cette méthode est aussi très rapide
à l'exécution :

'---------------------------------------------
Sub TrouverFormat()

Dim Rg As Range
Dim LeCellFormat As CellFormat

Set LeCellFormat = Application.FindFormat
'Détermine les caractéristiques
'du format de cellule recherché.
With LeCellFormat
.Clear 'S'assurer d'effacer les critères
'des anciennes recherches
.Interior.ColorIndex = 36
'La liste pourrait être plus longue ...
End With

'Détermine la plage de cellules où s'effectue
'la recherche
With Worksheets("Feuil1")
Set Rg = .Range("A:A")
End With

'Trouve la cellule ayant le bon format pour
'y effectuer une ou des opérations quelconques...
With Rg
Set C = .Find(What:="", SearchFormat:=True)
If Not C Is Nothing Then
adr = C.Address
Do
'Le code que tu veux exécuter avec la cellule trouvée
C.Select
'pour passer à la cellule suivante ...
Set C = .Find(What:="", after:¬tiveCell, SearchFormat:=True)
Loop Until C.Address = adr
End If
End With

End Sub
'---------------------------------------------


Salutations!



"Ghyslain" a écrit dans le message de news:
Bonjour a tous,
j'ai la macro suivante qui s"execute a l'aide de ctrl + tab

Dim nblig&
Dim R As Range
Dim C As Range
Set R = ActiveSheet.UsedRange
nblig& = R.Row + R.Rows.Count - 1
Set R = Range("a" & Selection.Row + 1 _
& ":a" & nblig& & "")
For Each C In R
If C.Interior.ColorIndex = 36 Then
If Rows(C.Row).Interior.ColorIndex = 36 Then
C.Select
Exit For
End If
End If
Next C
********************************************

Mais j'aimerai bien qu'il remonte a la premiere cellule jaune lorsque il en
trouve plus .... donc qu'il recommence au debut quand il a fini de les
trouver la il arrete ce qui est normal car il en voi plus d'autre.
Y a t-il une facons de le faire recommencer ou de mettre un msgbox qui dit
aucune autre ligne de couleur jaune trouver et qui recommence du debut apres
sa ??

Merci de votre aide
Avatar
Ghyslain
Bonjour,
Merci de vos reponse mais cela ne marche pas plus. Je me suis
peut-etre mal exprimer dans le fond quand je pese sur crtl + tab il descend
a ma premier ligne qui est en jaune .... quand je repese il trouve la
seconde .... ainsi de suite. Dans mon cas la derniere ligne jaune ce trouve
en A320..... et l'orsqu'il est rendu a A320 et que je repese sur ctrl + tab
et bien il reste a A320. Ce que je voudrait c'Est qu'il retourne a la
premiere ligne jaune.

merci de votre aide

"Ghyslain" a écrit dans le message de news:

Bonjour a tous,
j'ai la macro suivante qui s"execute a l'aide de ctrl + tab

Dim nblig&
Dim R As Range
Dim C As Range
Set R = ActiveSheet.UsedRange
nblig& = R.Row + R.Rows.Count - 1
Set R = Range("a" & Selection.Row + 1 _
& ":a" & nblig& & "")
For Each C In R
If C.Interior.ColorIndex = 36 Then
If Rows(C.Row).Interior.ColorIndex = 36 Then
C.Select
Exit For
End If
End If
Next C
********************************************

Mais j'aimerai bien qu'il remonte a la premiere cellule jaune lorsque il
en trouve plus .... donc qu'il recommence au debut quand il a fini de les
trouver la il arrete ce qui est normal car il en voi plus d'autre.
Y a t-il une facons de le faire recommencer ou de mettre un msgbox qui dit
aucune autre ligne de couleur jaune trouver et qui recommence du debut
apres sa ??

Merci de votre aide




Avatar
docm
Essaie ceci:

Dim nblig&
Dim R As Range
Dim C As Range
Set R = ActiveSheet.UsedRange
nblig& = R.Row + R.Rows.Count - 1

If Selection.Row = 65536 Or Selection.Row + 1 > nblig& Then
Range("a1").Select
End If

Set R = Range("a" & Selection.Row + 1 _
& ":a" & nblig& & "")

For Each C In R
If C.Interior.ColorIndex = 36 Then
If Rows(C.Row).Interior.ColorIndex = 36 Then
C.Select
Ok = 2
Exit For
End If
End If
Next C

docm

"Ghyslain" a écrit dans le message news:
OZpNrE#
Bonjour,
Merci de vos reponse mais cela ne marche pas plus. Je me suis
peut-etre mal exprimer dans le fond quand je pese sur crtl + tab il
descend

a ma premier ligne qui est en jaune .... quand je repese il trouve la
seconde .... ainsi de suite. Dans mon cas la derniere ligne jaune ce
trouve

en A320..... et l'orsqu'il est rendu a A320 et que je repese sur ctrl +
tab

et bien il reste a A320. Ce que je voudrait c'Est qu'il retourne a la
premiere ligne jaune.

merci de votre aide

"Ghyslain" a écrit dans le message de news:

Bonjour a tous,
j'ai la macro suivante qui s"execute a l'aide de ctrl + tab

Dim nblig&
Dim R As Range
Dim C As Range
Set R = ActiveSheet.UsedRange
nblig& = R.Row + R.Rows.Count - 1
Set R = Range("a" & Selection.Row + 1 _
& ":a" & nblig& & "")
For Each C In R
If C.Interior.ColorIndex = 36 Then
If Rows(C.Row).Interior.ColorIndex = 36 Then
C.Select
Exit For
End If
End If
Next C
********************************************

Mais j'aimerai bien qu'il remonte a la premiere cellule jaune lorsque il
en trouve plus .... donc qu'il recommence au debut quand il a fini de
les


trouver la il arrete ce qui est normal car il en voi plus d'autre.
Y a t-il une facons de le faire recommencer ou de mettre un msgbox qui
dit


aucune autre ligne de couleur jaune trouver et qui recommence du debut
apres sa ??

Merci de votre aide








Avatar
Ghyslain
Bonjour docm

un gros merci c'est exactement ce que je cherchait :)

merci a tous de votre aide ! c'est apprecié
"docm" a écrit dans le message de news:
OXzV%23D$
Essaie ceci:

Dim nblig&
Dim R As Range
Dim C As Range
Set R = ActiveSheet.UsedRange
nblig& = R.Row + R.Rows.Count - 1

If Selection.Row = 65536 Or Selection.Row + 1 > nblig& Then
Range("a1").Select
End If

Set R = Range("a" & Selection.Row + 1 _
& ":a" & nblig& & "")

For Each C In R
If C.Interior.ColorIndex = 36 Then
If Rows(C.Row).Interior.ColorIndex = 36 Then
C.Select
Ok = 2
Exit For
End If
End If
Next C

docm

"Ghyslain" a écrit dans le message news:
OZpNrE#
Bonjour,
Merci de vos reponse mais cela ne marche pas plus. Je me suis
peut-etre mal exprimer dans le fond quand je pese sur crtl + tab il
descend

a ma premier ligne qui est en jaune .... quand je repese il trouve la
seconde .... ainsi de suite. Dans mon cas la derniere ligne jaune ce
trouve

en A320..... et l'orsqu'il est rendu a A320 et que je repese sur ctrl +
tab

et bien il reste a A320. Ce que je voudrait c'Est qu'il retourne a la
premiere ligne jaune.

merci de votre aide

"Ghyslain" a écrit dans le message de news:

Bonjour a tous,
j'ai la macro suivante qui s"execute a l'aide de ctrl + tab

Dim nblig&
Dim R As Range
Dim C As Range
Set R = ActiveSheet.UsedRange
nblig& = R.Row + R.Rows.Count - 1
Set R = Range("a" & Selection.Row + 1 _
& ":a" & nblig& & "")
For Each C In R
If C.Interior.ColorIndex = 36 Then
If Rows(C.Row).Interior.ColorIndex = 36 Then
C.Select
Exit For
End If
End If
Next C
********************************************

Mais j'aimerai bien qu'il remonte a la premiere cellule jaune lorsque
il
en trouve plus .... donc qu'il recommence au debut quand il a fini de
les


trouver la il arrete ce qui est normal car il en voi plus d'autre.
Y a t-il une facons de le faire recommencer ou de mettre un msgbox qui
dit


aucune autre ligne de couleur jaune trouver et qui recommence du debut
apres sa ??

Merci de votre aide