• Initiateur de la discussion Initiateur de la discussion jeanphi
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

jeanphi

XLDnaute Occasionnel
bonjour le forum


dans un classeur je souhaite faire la comparaison de 2 feuilles
les conditions sont les suivantes:
si un numéro de série de la colonne E de la feuille "OSIA" correspond à un numéro de série de la colonne H de la feuille "Liste des biens" et si en plus le prix de la colonne V ou X de la feuille "OSIA" divisé par 12 correspond au prix de la colonne Q ou R de la feuille "Liste des biens", alors je souhaite que la ligne correspondant à ces critères dans la feuille "Liste des biens" soit colorée en rouge
Y'a t'il un pro qui pourrait m'aider à faire cela????
Merci 🙂
 

Pièces jointes

Dernière édition:
Re : Comparer 2 feuilles

Bonsoir jeanphi,

Test ce code :

Code:
Sub recherch()

Dim c As Range
Dim cell As Range

For Each cell In Sheets("OSIA").Range("E2:E" & Sheets("OSIA").Range("E65536").End(xlUp).Row)
    With Sheets("Liste des biens").Range("H2:H" & Sheets("Liste des biens").Range("H65536").End(xlUp).Row)
       Set c = .Find(cell, LookIn:=xlValues)
           If Not c Is Nothing Then
              If c.Offset(0, 9) Or c.Offset(0, 10) = cell.Offset(0, 17) / 12 Or cell.Offset(0, 19) / 12 Then
                 c.Interior.ColorIndex = 3
              End If
           End If
    End With
Next

End Sub
Le principe :

Pour chaque cellule de la colonne E de la feuille OSIA (For each .../...)
Dans la feuille Liste des biens, colonne H (with sheets("Liste .../...)
Recherche de la valeur (Set c = .find .../...)
Si trouvée (If not c .../...)
Test des valeurs ( if c.Offset .../...)
Si OK la cellule passe en rouge ( C.Interior .../...)

Bon test, car c'est pas facile avec des références pareils 😀

Bonne soirée
 
Re : Comparer 2 feuilles

PO

je souhaite apporter encore deux petites modif:
je souhaite que la ligne de la feuille OSIA soit elle aussi coloriée en rouge
par ailleurs avec ton code j ai la ligne H3 de la feuille liste des biens qui se colore meme si elle ne correspond pas aux criteres de recherche
comment faire pr éviter cela??? 🙂
MERCI encore!!!
 

Pièces jointes

Re : Comparer 2 feuilles

Bonjour,

Par une mise en forme conditionnelle,
en donnant un nom aux 3 plages de la feuille « Osia » et aux 3 plages de la feuille des listes

Formule de la Mefc pour la feuille des listes :
=SOMMEPROD((NoOsia=$H2)*((PxSgOsia/12=$Q2)*($Q2<>"")+(PxHgOsia/12=$R2)*($R2<>"")))

Pour la feuille « Osia »
=SOMMEPROD((NoList=$E3)*((PxSgList=$V3/12)*($V3<>"")+(PxHgList=$X3/12)*($X3<>"")))

Les plages nommées dans la feuille « Osia » :
=DECALER(OSIA!$E$2;;;EQUIV("zz";OSIA!$E:$E)-1)
Equiv() pour avoir la position de la dernière cellule non vide de la colonne E
Decaler(Réf ; 0 ligne ; 0 colonne ; Hauteur par Equiv ; Largeur 1 omis)

Dans la feuille des listes :
=DECALER('Liste des biens'!$H$2;;;NBVAL('Liste des biens'!$H:$H)-1)

Et puis pas rouge, je tiens à garder ma vue intacte
 

Pièces jointes

Re : Comparer 2 feuilles

Re, bonjour Monique

Le code modifié.

Code:
Sub recherch()

Dim c As Range
Dim cell As Range

Application.ScreenUpdating = False

For Each cell In Sheets("OSIA").Range("E2:E" & Sheets("OSIA").Range("E65536").End(xlUp).Row)
    With Sheets("Liste des biens").Range("H2:H" & Sheets("Liste des biens").Range("H65536").End(xlUp).Row)
       Set c = .Find(cell, LookIn:=xlValues)
           If Not c Is Nothing Then
              If c.Offset(0, 9) = cell.Offset(0, 17) / 12 And c.Offset(0, 9) <> 0 And cell.Offset(0, 17) / 12 <> 0 Then
                 c.Interior.ColorIndex = 3
                 cell.Interior.ColorIndex = 3
               End If
                 If c.Offset(0, 10) = cell.Offset(0, 19) / 12 And c.Offset(0, 10) <> 0 And cell.Offset(0, 19) / 12 <> 0 Then
                    c.Interior.ColorIndex = 3
                    cell.Interior.ColorIndex = 3
                 End If
           End If
    End With
Next

Application.ScreenUpdating = True

End Sub

Un jour il faudra que je me mette aux formules 😀

Bonne soirée
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
699
Réponses
15
Affichages
820
Retour