Sub Comparer()
Dim h As Long, cel As Range, i As Integer
'---initialisation---
Application.ScreenUpdating = False
[F2:F65536].ClearContents
[F2:F65536].Font.Bold = False
[F2:F65536].Font.ColorIndex = xlAutomatic
h = [E65536].End(xlUp).Row - 1
If h = 0 Then Exit Sub
'---remplissage de la colonne F---
[F2].Resize(h) = [E2].Resize(h).Value
'---comparaison avec la colonne C---
For Each cel In [F2].Resize(h)
For i = 1 To Len(cel.Text)
If Mid(cel.Text, i, 1) <> Mid(cel.Offset(, -3).Text, i, 1) Then
cel.Characters(i, 1).Font.Bold = True 'gras
cel.Characters(i, 1).Font.ColorIndex = 3 'rouge
End If
Next
Next
End Sub
Par contre comparer des textes situés sur des lignes différentes n'est guère logique
Sub Comparer()
Dim h&, cel As Range, cel1 As Range, Ndif%(), i%
'---initialisation---
Application.ScreenUpdating = False
[F2:F65536].ClearContents
[F2:F65536].Font.Bold = False
[F2:F65536].Font.ColorIndex = xlAutomatic
h = [E65536].End(xlUp).Row - 1
If h = 0 Then Exit Sub
For Each cel In [F2].Resize(h)
'---recherche du nombre de différences minimum---
cel = cel.Offset(, -3)
ReDim Ndif(1 To h)
For Each cel1 In [E2].Resize(h)
For i = 1 To Len(cel.Text)
If Mid(cel.Text, i, 1) <> Mid(cel1.Text, i, 1) Then _
Ndif(cel1.Row - 1) = Ndif(cel1.Row - 1) + 1
Next
Next
cel = [E1].Offset(Application.Match(Application.Min(Ndif), Ndif, 0))
'---comparaison avec la colonne C---
For i = 1 To Len(cel.Text)
If Mid(cel.Text, i, 1) <> Mid(cel.Offset(, -3).Text, i, 1) Then
cel.Characters(i, 1).Font.Bold = True 'gras
cel.Characters(i, 1).Font.ColorIndex = 3 'rouge
End If
Next
Next
End Sub
Sub Comparer()
Dim h As Long, cel As Range, i As Integer
'---initialisation---
Application.ScreenUpdating = False
[F2:F65536].ClearContents
[F2:F65536].Font.Bold = False
[F2:F65536].Font.ColorIndex = xlAutomatic
h = [E65536].End(xlUp).Row - 1
If h = 0 Then Exit Sub
'---tris préalables---
[A:E].Sort [A1], , [B1], Header:=xlYes
[D:D].Insert: [A:A].Copy [D1]
[D:F].Sort [D1], , [E1], Header:=xlYes
[D:D].Delete
'---remplissage de la colonne F---
[F2].Resize(h) = [E2].Resize(h).Value
'---comparaison avec la colonne C---
For Each cel In [F2].Resize(h)
For i = 1 To Len(cel.Text)
If Mid(cel.Text, i, 1) <> Mid(cel.Offset(, -3).Text, i, 1) Then
cel.Characters(i, 1).Font.Bold = True 'gras
cel.Characters(i, 1).Font.ColorIndex = 3 'rouge
End If
Next
Next
End Sub
Sub Comparer()
Dim h As Long, cel As Range, i As Integer
'---initialisation---
Application.ScreenUpdating = False
[F2:G65536].ClearContents
[F2:G65536].Font.Bold = False
[F2:G65536].Font.ColorIndex = xlAutomatic
h = Application.Max([C65536].End(xlUp).Row, [E65536].End(xlUp).Row) - 1
If h = 0 Then Exit Sub
'---tris préalables---
[A:E].Sort [A1], , [B1], Header:=xlYes
[D:D].Insert: [A:A].Copy [D1]
[D:F].Sort [D1], , [E1], Header:=xlYes
[D:D].Delete
'---remplissage des colonnes F et G---
[F2].Resize(h) = [C2].Resize(h).Value
[G2].Resize(h) = [E2].Resize(h).Value
'---comparaison des colonnes F et G---
For Each cel In [F2].Resize(h)
For i = 1 To Application.Max(Len(cel.Text), Len(cel.Offset(, 1).Text))
If Mid(cel.Text, i, 1) <> Mid(cel.Offset(, 1).Text, i, 1) Then
cel.Characters(i, 1).Font.Bold = True 'gras
cel.Characters(i, 1).Font.ColorIndex = 3 'rouge
cel.Offset(, 1).Characters(i, 1).Font.Bold = True
cel.Offset(, 1).Characters(i, 1).Font.ColorIndex = 3
End If
Next
Next
End Sub