Rechercher plusieurs valeurs et appliquer style

Bonjour à tous,

je me lance timidement dans VBA parce que je traite en ce moment de gros volumes d'excel et que tout faire à la main prendrais bien trop de temps.

Mon problème du moment est le suivant :

j'ai un classeur excel avec 2 feuilles.

La premiere comporte 1500 lignes correspondant chacune à un projet de recherche, avec 7 colonnes (nom du projet, résumé, date de début, de fin, thématique...)

La seconde compte 24 lignes, correspond à 24 des projets de recherche issues de la feuille 1

Ce que je voudrais maintenant c'est retrouver ces 24 projets dans la feuille une et les surligner, pour les identifier facilement parmi les 1500 lignes.

j'arrive à le faire 1 par 1 avec le code suivant :

Sub Macro2()

'

' Macro2 Macro

'

'

Cells.Find(What:="prodemos", After:=ActiveCell, LookIn:=xlFormulas, _

LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _

MatchCase:=False, SearchFormat:=False).Activate

Range(Selection, Selection.End(xlToRight)).Select

Selection.Style = "20 % - Accent5"

End Sub

prodemos étant le nom d'un des projets

je voudrais maintenant, plutôt que de les chercher un par un faire intervenir un "i As Integer" pour que VBA aille chercher tout seul les valeur ligne après ligne dans la feuille 2 et trouve et applique le style voulu en feuille 1.

je joins l'un de mes fichier au cas où

Je vous serez grandement reconnaissant si vous avez des idées car j'ai encore plein de fichier excel de ce genre à traiter.

Merci merci merci

Clemsshop

Hello clemsshop,

regarde si cela peut te convenir.

Bonjour,

Une piste :

Sub Test()

    Dim PlgBase As Range
    Dim PlgProjet As Range
    Dim Cel As Range
    Dim CelTrouve As Range

    With Worksheets("projets h2020 FR SE"): Set PlgBase = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
    With Worksheets("Feuil1"): Set PlgProjet = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

    PlgBase.Resize(, 9).Cells.Interior.ColorIndex = 0

    For Each Cel In PlgProjet

        Set CelTrouve = PlgBase.Find(Cel.Value, , xlValues, xlWhole)

        If Not CelTrouve Is Nothing Then PlgBase.Range(CelTrouve, CelTrouve.Offset(, 8)).Interior.ColorIndex = 37

    Next Cel

End Sub

Bonjour Bigdaddy154,

c'est tout à fait ça, et j'étais du coup très très loin du compte avec mon code.

j'ai, je crois, plutôt bien comrpsi ton code, et je pense qu'il soit très facilement applicable à tous mes fichiers du coup !

merci infiniment.

clemsshop

Bonjour Theze,

Merci pour ton code, il marche très bien, cependant il y a un petit souci parce que cela surligne la ligne en dessous de chacune des valeurs cibles

Re,

Oui, effectivement, comme la plage commence à la ligne 2, le fait de faire référence à la plage plutôt qu'à la feuille fait qu'il y a ce décalage donc c'est plutôt comme ceci :

Sub Test()

    Dim PlgBase As Range
    Dim PlgProjet As Range
    Dim Cel As Range
    Dim CelTrouve As Range

    With Worksheets("projets h2020 FR SE"): Set PlgBase = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
    With Worksheets("Feuil1"): Set PlgProjet = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

    PlgBase.Resize(, 9).Cells.Interior.ColorIndex = 0

    For Each Cel In PlgProjet

        Set CelTrouve = PlgBase.Find(Cel.Value, , xlValues, xlWhole)

        If Not CelTrouve Is Nothing Then Worksheets("projets h2020 FR SE").Range(CelTrouve, CelTrouve.Offset(, 8)).Interior.ColorIndex = 37

    Next Cel

End Sub

au top ! merci à tous les deux ! je mets le sujet en résolu du coup