selection d'une plage de cellule en fonction d'une autre colonne et test

Bonjour,

Mise en forme conditionnelle sur la cellule A5 contenant le libellé à
trouver :
=SOMMEPROD(($A$7:$A$14=$A$5)*($G$7:$G$14=1))>=1

Camille

"no-comment" <no-comment@domain-xyz.in> a écrit dans le message de news:
A9adnbPOivyCLRzURVn_vwA@giganews.com...

Bonjour,

Dans une feuille 1, je souhaite identifier les cellules de la colonne A
dans
lesquelles se trouve un texte défini (Ces cellules se suivent
obligatoirement).
Une fois identifiées, je souhaite selectionner les cellules de la colonne
G
correspondantes, et y tester si la valeur 1 est présente au moins une fois
dans
la plage de cellules.
Si c'est le cas, la cellule (ligne 5) comportant le texte défini, sur la
feuille 2 devra se colorer en rouge.


Merci d'avance pour votre aide,
Cordialement,

Salut à toi

Soit Feuil1 colonne A le texte à rechercher colonne G la valeur 1 à rechercher
Soit en Feuil2 ligne 5 le texte à colorier
Je te propose ce code :

On Error Resume Next
Texte = InputBox("Saisissez le Texte", "Texte à rechercher")
Ligne = Sheets("Feuil1").Range("A1", "A" &
Sheets("Feuil1").Range("A65535").End(xlUp).Row).Find(What:=Texte,
After:=Sheets("Feuil1").Range("A1"), LookIn:= _
xlValues, LookAt:=xlWhole).Row

If Ligne > 1 Then
i = 0
Do While Sheets("Feuil1").Range("A" & Ligne) = Sheets("Feuil1").Range("A" &
Ligne + i)
If Sheets("Feuil1").Range("G" & Ligne + i) = 1 Then
Sheets("Feuil2").Rows("5:5").Find(What:=Texte,
After:=Sheets("Feuil2").Range("A5"), LookIn:= _
xlValues, LookAt:=xlWhole).Interior.ColorIndex = 3
Exit Do
End If
i = i + 1
Loop
Else
MsgBox ("Le Texte est introuvable")
End If

Celà devrait convenir
Dis moi !!!!

FFO a écrit le 29/01/2009 à 15h09 :

Salut à toi

Soit Feuil1 colonne A le texte à rechercher colonne G la valeur 1
à rechercher
Soit en Feuil2 ligne 5 le texte à colorier
Je te propose ce code :

On Error Resume Next
Texte = InputBox("Saisissez le Texte", "Texte à
rechercher")
Ligne = Sheets("Feuil1").Range("A1", "A" &
Sheets("Feuil1").Range("A65535").End(xlUp).Row).Find(What:=Texte,
After:=Sheets("Feuil1").Range("A1"), LookIn:= _
xlValues, LookAt:=xlWhole).Row

If Ligne > 1 Then
i = 0
Do While Sheets("Feuil1").Range("A" & Ligne) =
Sheets("Feuil1").Range("A" &
Ligne + i)
If Sheets("Feuil1").Range("G" & Ligne + i) = 1 Then
Sheets("Feuil2").Rows("5:5").Find(What:=Texte,
After:=Sheets("Feuil2").Range("A5"), LookIn:= _
xlValues, LookAt:=xlWhole).Interior.ColorIndex = 3
Exit Do
End If
i = i + 1
Loop
Else
MsgBox ("Le Texte est introuvable")
End If

Celà devrait convenir
Dis moi !!!!

Impecable,
J'ai juste changé
Texte = InputBox("Saisissez le Texte", "Texte à
rechercher")
par
Texte = "item1"
parce que je veux que ce soit automatique (les items sont prédéfinis, l'utilisateur ne doit pas les changer)

Par contre, j'ai oublié un détail...
J'ai donc mis un bouton auquel est affecté la macro pour actualiser le tableau en feuille2 en fonction de la présence de "1" dans la colonne G, Feuille1.
J'aimerais que la couleur s'enlève si il n'y a plus de "1" dans la plage de cellules concernée.

Je sais que ce doit être quelque chose comme
(...)

Else
ActiveCell.Interior.ColorIndex = 0
Exit Do
End If
i=i+1
Loop
Else
MsgBox("Le texte est introuvable")
End If

Mais ca ne marche pas :(

Si tu peux encore m'aider... :)
Sinon, merci beaucoup car le plus important marche :)

Rebonjour à toi

Heureux que celà te convienne
Pour affecter une couleur ou pas de couleur change cette partie :

Do While Sheets("Feuil1").Range("A" & Ligne) = Sheets("Feuil1").Range("A" &
Ligne + i)
If Sheets("Feuil1").Range("G" & Ligne + i) = 1 Then
Trouvé = 1
Exit Do
End If
i = i + 1
Loop
If Trouvé = 1 Then
Sheets("Feuil2").Rows("5:5").Find(What:=Texte,
After:=Sheets("Feuil2").Range("A5"), LookIn:= _
xlValues, LookAt:=xlWhole).Interior.ColorIndex = 3
Else
Sheets("Feuil2").Rows("5:5").Find(What:=Texte,
After:=Sheets("Feuil2").Range("A5"), LookIn:= _
xlValues, LookAt:=xlWhole).Interior.ColorIndex = xlNone
End If

Ce qui donne au final :

On Error Resume Next
Texte = InputBox("Saisissez le Texte", "Texte à rechercher")
Ligne = Sheets("Feuil1").Range("A1", "A" &
Sheets("Feuil1").Range("A65535").End(xlUp).Row).Find(What:=Texte,
After:=Sheets("Feuil1").Range("A1"), LookIn:= _
xlValues, LookAt:=xlWhole).Row

If Ligne > 1 Then
i = 0
Do While Sheets("Feuil1").Range("A" & Ligne) = Sheets("Feuil1").Range("A" &
Ligne + i)
If Sheets("Feuil1").Range("G" & Ligne + i) = 1 Then
Trouvé = 1
Exit Do
End If
i = i + 1
Loop
If Trouvé = 1 Then
Sheets("Feuil2").Rows("5:5").Find(What:=Texte,
After:=Sheets("Feuil2").Range("A5"), LookIn:= _
xlValues, LookAt:=xlWhole).Interior.ColorIndex = 3
Else
Sheets("Feuil2").Rows("5:5").Find(What:=Texte,
After:=Sheets("Feuil2").Range("A5"), LookIn:= _
xlValues, LookAt:=xlWhole).Interior.ColorIndex = xlNone
End If
Else
MsgBox ("Le Texte est introuvable")
End If

Celà devrait faire
Dis moi !!!!