Buenas tardes a todos.

Estoy buscando una macro que me calcule el porcentaje de similitud entre dos celdas.

Buscando por internet he encontrado estas macros que calculan justo lo que estaba buscando ( http://miguelmaresmahurtado.com/index.php/2016/03/14/porcentaje-de-similitud-entre-dos-textos/) pero ambas me dan error y no sé arreglarlo. 

Si alguien pudiera ayudarme o sugerirme otra macro sería de gran utilidad.

Adjunto mi ejemplo. Muchas gracias y espero que todos se encuentren sanos y en casa

Ejemplo.xlsx

Hola te comparto tu adjunto con la función que has encontrado en Internet.

Ejemplo (2)prueba(1).xlsm

Lo mismo, de otra manera sin considerar los acentos.

Function Similitud_Porcentual(Cadena1 As String, Cadena2 As String) As Integer
Dim Texto1 As Variant, Texto2 As Variant, x As Integer, Veces As Integer
If Cadena1 = "" Or Cadena2 = "" Then Exit Function
'--
Cadena1 = Homogeneizar(LCase(Cadena1))
Cadena2 = Homogeneizar(LCase(Cadena2))
'--
Texto1 = Split(Cadena1)
Texto2 = Split(Cadena2)
Total = UBound(Texto1) + 1
If UBound(Texto2) > UBound(Texto1) Then Total = UBound(Texto2) + 1
'--
For x = 0 To UBound(Texto1)
   If UBound(Filter(Texto2, Texto1(x))) > -1 Then
      Veces = Veces + 1
   End If
Next
Similitud_Porcentual = Round(Veces * 100 / Total, 0)
End Function

Function Homogeneizar(Cadena As String) As String
Homogeneizar = Replace(Cadena, "á", "a")
Homogeneizar = Replace(Homogeneizar, "é", "e")
Homogeneizar = Replace(Homogeneizar, "í", "i")
Homogeneizar = Replace(Homogeneizar, "ó", "o")
Homogeneizar = Replace(Homogeneizar, "ú", "u")
Homogeneizar = Replace(Homogeneizar, "ü", "u")
End Function

 

Editado el el 9 de abril5 años por Antoni

Muchas gracias a ambo. Me ha sido de grandísima utilidad