Option Explicit
Sub travdem()
Dim cellule As Range, plage As Range
Dim nomfeuille1 As String
Dim i As Long, k As Byte, nb1 As Byte, nb As Byte
' pour boucler sur la colonne 1
nomfeuille1 = "Feuil1"
With Sheets(ActiveSheet.Name)
'Je souhaite avoir "Match" en bout de ligne quand
'toutes les descriptions existantes sont égales,
's'il y en a au moins une de différente alors "No Match".
'Le summum serait d'avoir un pourcentage correspondant au nombre d'égalités
'(i.e. si 3 données identiques 3, blancs Match = 100% ;
'2 données identiques 1 non id 3 blancs, match = 66% (2/3)
For Each cellule In .Range("a2:a" & .Cells(Rows.Count, 1).End(xlUp).Row)
k = 0
For i = 1 To 6
If cellule.Offset(0, i).Value <> "" Then k = k + 1
Next i
' k cellule occupé
Set plage = .Range("A" & cellule.Row & ":g" & cellule.Row)
nb = Application.WorksheetFunction.CountIf(plage, cellule.Offset(0, 1).Value)
nb1 = 0
For i = 1 To 6
nb = Application.WorksheetFunction.CountIf(plage, cellule.Offset(0, i).Value)
If nb > nb1 Then nb1 = nb
Next i
If nb1 = k Then
cellule.Offset(0, 8) = "Match"
cellule.Offset(0, 9) = "100%"
Else
If k <> 0 Then
cellule.Offset(0, 8) = "NoMatch"
cellule.Offset(0, 9) = nb1 / k
cellule.Offset(0, 9).Style = "Percent"
End If
End If
Next cellule
End With
End Sub