Boucle

Marc · 16 Octobre 2005

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 · 16 Octobre 2005

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]

Marc · 16 Octobre 2005

Bonjour _Thoerry
Avec tous mes remerciements.
Il se peut que je revienne vers toi si cela ne t'ennuie pas.
Amicalement

PascalXLD · 16 Octobre 2005

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! · 16 Octobre 2005

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! · 16 Octobre 2005

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 · 16 Octobre 2005

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]

Marc · 16 Octobre 2005

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 · 16 Octobre 2005

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]

Marc · 16 Octobre 2005

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

myDearFriend! · 16 Octobre 2005

Re

Marc, je te rappelle que dans le fil original Lien supprimé il était question d'une seule cellule avec fond rouge !

Pour ma part, je suis comme _Thierry, je ne comprends plus rien de ce que tu souhaite faire...

Cordialement,

Marc · 16 Octobre 2005

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 · 16 Octobre 2005

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! · 16 Octobre 2005

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 · 16 Octobre 2005

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]

Boucle

Marc

Guest

_Thierry

XLDnaute Barbatruc

Marc

Guest

PascalXLD

XLDnaute Barbatruc

myDearFriend!

XLDnaute Barbatruc

myDearFriend!

XLDnaute Barbatruc

_Thierry

XLDnaute Barbatruc

Marc

Guest

_Thierry

XLDnaute Barbatruc

Marc

Guest

myDearFriend!

XLDnaute Barbatruc

Marc

Guest

_Thierry

XLDnaute Barbatruc

myDearFriend!

XLDnaute Barbatruc

_Thierry

XLDnaute Barbatruc

Discussions similaires