VBA repérer des "doublons" sur la base du premier mot Fermé

Question

bonjour, Je suis à la recherche d'un macro qui me permettrait de repérer des "doublons". Ce ne sont pas des doublons à proprement parler parce que les cellules peuvent ne pas être identiques. Par exemple "Volvo" et "Volvo SA" seront considérés comme des doublons. J'ai trouvé cette macro qui marche super bien mais qui ne détecte que les doublons identiques. Sub Doublons() Dim Collec As New Collection, Cell As Range, Plage As Range On Error Resume Next Set Plage = Application.InputBox("Plage à examiner", Type:=8) If IsEmpty(Plage) Then Exit Sub For Each Cell In Plage If Cell.Value <> "" Then Collec.Add Cell.Value, CStr(Cell.Value) If Err <> 0 Then Err.Clear Cell.Interior.ColorIndex = 3 Else Cell.Interior.ColorIndex = 4 End If End If Next Cell End Sub L'idée serait de reprendre la même macro mais en améliorant celle-ci de sorte à ce que toutes les cellules ayant le même premier mot soient mis en rouge. Quelqu'un pourrait-il me venir en aide pleaaase? En vous remerciant d'avance. Bien cordialement

florent · Answer

Je n'en suis pas sûr, mais essayer ceci : Sub Doublons() Dim Collec As New Collection, Cell As Range, Plage As Range Dim chn As String, mot As String, p As Byte On Error Resume Next Set Plage = Application.InputBox("Plage à examiner", Type:=8) If IsEmpty(Plage) Then Exit Sub For Each Cell In Plage chn = CStr(Cell.Value): p = InStr(chn, " ") If p = 0 Then mot = chn Else mot = Left$(chn, p - 1) If chn <> "" Then Collec.Add mot, chn If Err <> 0 Then Err.Clear Cell.Interior.ColorIndex = 3 Else Cell.Interior.ColorIndex = 4 End If End If Next Cell End Sub Merci de m'indiquer si ça a marché ou non ; si oui, tant mieux ; si non, pas d'autre idée.

VBA repérer des "doublons" sur la base du premier mot

1 réponse

Discussions similaires