Recherche en VBA

[eduraiss]

Bonjour le forum

Voila je voudrais faire une recherche de noms en VBA en attribuant une couleur si la cellule est trouvée

Voici un fichier joint qui sera plus précis

Merci a vous

 

[JCGL]

Re : Recherche en VBA

Bonjour à tous,

Peux-tu essayer avec ceci :

Option Explicit


Sub Test()
Dim Cel As Range
Dim Plage As Range
Dim X%
Set Plage = Feuil1.Range("C4:E200")
For Each Cel In Plage
For X = 2 To 4
If Cel = Cells(X, 6) Then Cel.Interior.ColorIndex = 4
Next X
Next Cel
End Sub

A + à tous

 

[eduraiss]

Re : Recherche en VBA

Re

Merci beaucoup JCGL cela fonctionne parfaitement

Cordialement

 

[JHA]

Re : Recherche en VBA

Bonjour à tous,

Par MFC avec une formule

JHA

 

[JCGL]

Re : Recherche en VBA

Bonjour à tous,

Un peu plus complet : respect des couleurs de tableaux par effacement des couleurs vertes

Je serai, moi aussi, plutôt pour une MeFC...

A + à tous

 

[Modeste geedee]

Re : Recherche en VBA

Bonsour®

Bonjour le forum

Voila je voudrais faire une recherche de noms en VBA en attribuant une couleur si la cellule est trouvée

Voici un fichier joint qui sera plus précis

Merci a vous

hélas Après JCGL,
sourire...
mais je propose quand même !

 

[job75]

Re : Recherche en VBA

Bonjour eduraiss, Jean-Claude, JHA, Modeste geedee,

Je pense aussi qu'une MFC est la solution la plus simple.

Une autre solution VBA avec recherche par SpecialCells :

Sub Couleur()
Dim r As Range
Application.ScreenUpdating = False
On Error Resume Next 'si les SpecialCells n'existent pas
'---réinitialisation---
For Each r In [B:B].SpecialCells(xlCellTypeConstants, 1).Areas
  r.Resize(, 4).Interior.Color = r.Interior.Color
Next
'---recherche et coloration---
For Each r In [F:F].SpecialCells(xlCellTypeConstants, 2)
  [C:E].Replace r, "#N/A"
  With [C:E].SpecialCells(xlCellTypeConstants, 16)
    .Interior.ColorIndex = 4 'vert
    .Value = r
  End With
Next
End Sub

Il vaut mieux mettre la macro dans le code de la feuille.

Fichier joint.

A+

 

[job75]

Re : Recherche en VBA

Re,

Sans LookAt:=xlWhole dans Replace on risque des problèmes...

Sub Couleur()
Dim r As Range
Application.ScreenUpdating = False
On Error Resume Next 'si les SpecialCells n'existent pas
'---réinitialisation---
For Each r In [B:B].SpecialCells(xlCellTypeConstants, 1).Areas
  r.Resize(, 4).Interior.Color = r.Interior.Color
Next
'---recherche et coloration---
For Each r In [F:F].SpecialCells(xlCellTypeConstants, 2)
  [C:E].Replace r, "#N/A", LookAt:=xlWhole
  With [C:E].SpecialCells(xlCellTypeConstants, 16)
    .Interior.ColorIndex = 4 'vert
    .Value = r
  End With
Next
End Sub

Fichier (2).

A+

 

[job75]

Re : Recherche en VBA

Bonsoir à tous,

Autre possibilité : l'utilisation de caractères génériques en colonne F.

Mais alors il faut mémoriser les valeurs dans un tableau :

Sub Couleur()
Dim r As Range, tablo
Application.ScreenUpdating = False
On Error Resume Next 'si les SpecialCells n'existent pas
'---réinitialisation des couleurs---
For Each r In [B:B].SpecialCells(xlCellTypeConstants, 1).Areas
  r.Resize(, 4).Interior.Color = r.Interior.Color
Next
'---mémorisation des valeurs---
tablo = Intersect([C:E], Me.UsedRange)
'---recherche et coloration---
For Each r In [F:F].SpecialCells(xlCellTypeConstants, 2)
  [C:E].Replace r, "#N/A", LookAt:=xlWhole
  [C:E].SpecialCells(xlCellTypeConstants, 16).Interior.ColorIndex = 4 'vert
Next
'---restitution des valeurs---
Intersect([C:E], Me.UsedRange) = tablo
End Sub

Fichier (3).

A+