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

Le
no-comment
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,
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Ellimac
Le #18523091
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"
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,


FFO
Le #18523081
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 !!!!
no-comment
Le #18524271
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 :)
FFO
Le #18524881
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 !!!!
Publicité
Poster une réponse
Anonyme