Boucle

M

Marc

Guest
Bonjour à tous,
Voilà je cherche comment écrire une boucle à partir de la cellule active et sur les 15 cellules suivantes vers le bas, jusqu'à ce qu'il rencontre la cellule égale à :
Interior.ColorIndex = 3
en vous remerciant tous
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonjour Marc, le Forum

Plusieurs possibilités de boucles s'offrent à toi pour ce genre de recherches, voici la plus simple :

Sub LookingForRedCell()
Dim Cell As Range

   
For Each Cell In Range('A1:A15')
       
If Cell.Interior.ColorIndex = 3 Then
            MsgBox 'Bingo ' & Cell.Address
           
Exit For
       
End If
   
Next

End Sub


Bon Dimanche
[ol]@+Thierry[/ol]
 

PascalXLD

XLDnaute Barbatruc
Modérateur
Bonjour

En reprenant la macro de Thierry et en l'adaptant à la cellule active

Sub LookingForRedCell()

Dim x As Integer

For x = 1 To 15
If ActiveCell.Offset(x, 0).Interior.ColorIndex = 3 Then
MsgBox 'Bingo !! ' & Cells(ActiveCell.Row + x, ActiveCell.Column).Address
Exit For
End If
Next

End Sub

Bon WE
 

myDearFriend!

XLDnaute Barbatruc
Bonjour Marc, _Thierry, Pascal76,

Tout comme Pascal, en reprenant le code de _Thierry et en l'adaptant à la cellule active :

Sub LookingForRedCell()
Dim Cell As Range
      For Each Cell In ActiveCell.Range('A1:A15')
            If Cell.Interior.ColorIndex = 3 Then
                  MsgBox 'Bingo ' & Cell.Address
                  Exit For
            End If
      Next
End Sub
Cordialement,
 

myDearFriend!

XLDnaute Barbatruc
Oups,

...et plus exactement :

Sub LookingForRedCell()
Dim Cell As Range
      For Each Cell In ActiveCell.Range('A2:A16')
            If Cell.Interior.ColorIndex = 3 Then
                  MsgBox 'Bingo ' & Cell.Address
                  Exit For
            End If
      Next
End Sub
Cordialement,
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Ouh la la y a toute l'équippe de Choc pour cette malheureuse boucle LOL

Bonjour à vous les gars et content de vous croiser.

En plus merci à vous j'avais carrément zapé que Marc parlait de cellule active Arf ! donc sympa de me corriger.

Dans la foulée voici en fait une méthode plus 'Star Académie' lol

Sub LookingForRedCell()
Dim Cell As Range
Dim Plage As Range

Set Plage = Range(ActiveCell, ActiveCell.Offset(15, 0))

   
For Each Cell In Plage
       
If Cell.Interior.ColorIndex = 3 Then
            MsgBox 'Bingo ' & Cell.Address
           
Exit For
       
End If
   
Next

End Sub

Bon Après midi
[ol]@+Thierry[/ol]
 
M

Marc

Guest
Je patauge... lamentablement
J'essaie de (mais je ne sais si vous me comprendrez) enfin

Sub Indentifier_Cellule()
Dim Plage As Range
Dim Cellule_Cible As Range
Dim Cell As Range
'Dim Value
Set Plage = Range('B7:H105')

If Application.FindFormat.Interior.ColorIndex = 3 Then
ActiveSheet.Cells.Find(What:='', SearchFormat:=True).Select

For Each Cell In ActiveCell.Range('A7:A105')

If Cell.Interior.ColorIndex = 3 Then
MsgBox 'Bingo ' & Cell.Address
Exit For
End If
Next
End If
End Sub

je crois que je mélange tout
 

_Thierry

XLDnaute Barbatruc
Repose en paix
RE Bonjour Marc, Pascal, Didier

Heuh je ne te suis plus là Marc ? ton FindFormat et ton Find n'ont pas lieu d'être dans la boucle que tu as demandé ?

Que veux-tu faire au juste ? car là tu nous perds aussi lol

Si tu veux juste sélectionner la première Cellule adjacente dans les 15 lignes qui sont en dessous de la Cellule Active avec un IndexColor 3 alors ce code suffit amplement :

Sub LookingForRedCell()
Dim Cell As Range
Dim Plage As Range

Set Plage = Range(ActiveCell, ActiveCell.Offset(15, 0))

   
For Each Cell In Plage
       
If Cell.Interior.ColorIndex = 3 Then
              Cell.Activate
           
Exit For
       
End If
   
Next

End Sub

Bon Dimanche
[ol]@+Thierry[/ol]
 
M

Marc

Guest
bonjour à tous

Par Didier mdf j'ai obtenu ceci
Application.FindFormat.Interior.ColorIndex = 3 Then
ActiveSheet.Cells.Find(What:='', SearchFormat:=True).Select

partant de là, je cherche à faire une boucle pour trouver la cellule parmi les 15 en dessous pour trouver celle qui est rouge

Boucle de _Thierry
Sub LookingForRedCell()
Dim Cell As Range

For Each Cell In Range('A1:A15')
If Cell.Interior.ColorIndex = 3 Then
MsgBox 'Bingo ' & Cell.Address
Exit For
End If
Next

End Sub

J'essai d'adapter les deux
 
M

Marc

Guest
Avec toutes mes excuses car je pensais être plus 'clair'
Donc, partant de ma première demande (excuse-moi encore Didier), je cherche à faire une boucle à partir de la cellule active parmi les 15 en dessous pour trouver celle qui est rouge

Le but est de :
trouver la cellule dont la date est identique à celle de B1, mais qui est à un emplacement variable dans la plage B5:H90
puis ensuite, trouver la cellule dont le fond est rouge en dessous de la cellule trouvée ci-avant.

Mais si cela peut simplifier pour vous, à l'intérieur de la plage B7:H105 il ne peut y avoir qu'une seule cellule rouge.
Je chercherai ensuite pour la faire clignoter.

En vous remerciant de votre patience
Marc
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Re Bonjour

Arf c'est pas évident de n'avoir que la moitié de la question pour pouvoir y répondre !!! lol

Bon essaie ceci Marc :

Option Explicit
Declare Sub Sleep Lib 'kernel32' (ByVal dwMilliseconds As Long)

Sub LookingForRedCell()
Dim FirstRedCell As Range
Dim Cell As Range
Dim Plage As Range
Dim i As Byte

   
For Each Cell In Range('B5:H90')
       
If Cell = Range('B1') Then
           
Set FirstRedCell = Cell
           
Exit For
       
End If
   
Next


Set Plage = Range(FirstRedCell.Offset(1, 0), ActiveCell.Offset(98, 0))

   
For Each Cell In Plage
       
If Cell.Interior.ColorIndex = 3 Then
              Cell.Activate
           
For i = 1 To 10
              Sleep (100)
              Cell.Interior.ColorIndex = 6
              Sleep (100)
              Cell.Interior.ColorIndex = 3
           
Next i
           
Exit For
       
End If
   
Next

End Sub


Pour Info à Didier le 'Application.FindFormat.Interior.ColorIndex = 3' ne semble pas être digéré par Excel 2000 (je branche un PC sous 2002 et un autre sur 2003 pour tester).

Bon Dimanche
[ol]@+Thierry[/ol]
 

myDearFriend!

XLDnaute Barbatruc
Re,

Si j'ai bien compris, ci-dessous une façon de faire :
Sub IdentifierCellule()
Dim Cell As Range
Dim C As Range
      With Range('B5:H90')
            Set C = .Find(Range('B1'), LookIn:=xlValues)
            If Not C Is Nothing Then
                  For Each Cell In C.Range('A2:A16')
                        If Cell.Interior.ColorIndex = 3 Then
                              MsgBox 'Bingo ' & Cell.Address
                              Exit For
                        End If
                  Next
            End If
      End With
End Sub
Cordialement,

Nb : si ça ne marche toujours pas, peut-être te faudrait-il Lien supprimé exemple du problème (épuré des données inutiles ou confidentielles bien-sûr)...

EDITION
:)
Extrait du constat amiable : _Thierry roulait tranquillement sur la voie de la raison lorsque 'Boom', myDearFriend! surgit de nulle part, et est venu le percuter comme un malpropre !!! Pardon _Thierry, mais c'était sûr qu'on échapperait pas à l'accident là !


Message édité par: myDearFriend!, à: 16/10/2005 15:40
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Hi hi hi Mort de Rire Didier

Bon testé sous 2003 'Application.FindFormat' fonctionne nickel chrome, je regarderai aussi sous XP (2002)

Sinon pour notre ami Marc, voici ma version un poil plus blindée car évidemment si il n'y a pas de date équivalente à B1 dans la Plage, boum ! (contrairement à la version de Didier d'ailleurs ;))

Option Explicit
Declare Sub Sleep Lib 'kernel32' (ByVal dwMilliseconds As Long)

Sub LookingForRedCell()
Dim FirstCell As Range
Dim Cell As Range
Dim Plage As Range
Dim i As Byte

   
For Each Cell In Range('B5:H90')
       
If Cell = Range('B1') Then
           
Set FirstCell = Cell
           
Exit For
       
End If
   
Next

   
If FirstCell Is Nothing Then
        MsgBox 'Date ' & Range('B1') & ' non trouvée, procédure avortée', vbCritical
       
Exit Sub
   
End If

Set Plage = Range(FirstCell.Offset(1, 0), ActiveCell.Offset(98, 0))

   
For Each Cell In Plage
       
If Cell.Interior.ColorIndex = 3 Then
              Cell.Activate
           
For i = 1 To 10
              Sleep (100)
              Cell.Interior.ColorIndex = 6
              Sleep (100)
              Cell.Interior.ColorIndex = 3
           
Next i
           
Exit For
       
End If
   
Next

End Sub

Reste plus qu'à savoir si on fait un constat amiable pour quelque chose qui correspond enfin à ce que souhaite Marc !!!

Bon Aprèm
[ol]@+Thierry[/ol]
 

Discussions similaires

Réponses
9
Affichages
266
Réponses
4
Affichages
193
  • Résolu(e)
Microsoft 365 Copier par mois
Réponses
23
Affichages
507

Statistiques des forums

Discussions
312 811
Messages
2 092 306
Membres
105 347
dernier inscrit
VLEN