Comparar dos celdas excel Obtener el % de igualdad
Sre. T.E.
De Uds. Necesito una macro para comparar dos celdas y obtener el porcentaje de igualdad.
Ejemplo:
Celda "A1" = "Mi Pc es Marca DELL"
Celda "B1" = "DELL es mi Pc"
Que % tiene de diferencia la Celda "A1" de "B1"
2 Respuestas
Luego de enviar la consulta, he ubicado tu enlace “http://miguelmaresmahurtado.com/index.php/2016/03/14/porcentaje-de-similitud-entre-dos-textos/ “, exactamente lo que necesitaba.
Esto lo imagino como obtener la repuesta antes de consulta.
Gracias
Claro esta lo adapte a mi necesidad te muestro:
Dim cnt1, cnt2, Cant, i As Integer, Porcentaje As Double
Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Cells.Count > 1 Then
Exit Sub
End If
UltCelda = Cells(Rows.Count, 1).End(xlUp).Row - 1
For CellsEnd = 5 To UltCelda
ProveedEnExist = Trim(Replace(ProveedEnExist, " ", ""))
EntDeProveed = Trim(Replace(EntDeProveed, " ", ""))
ProveedEnExist = Cells(CellsEnd, 1)
EntDeProveed = Target
cnt1 = Len(ProveedEnExist)
cnt2 = Len(EntDeProveed)
Cant = 0
Porcentaje = 0
If cnt1 <= cnt2 Then
For i = 1 To cnt1
If Mid(ProveedEnExist, i, 1) = Mid(EntDeProveed, i, 1) Then
Cant = Cant + 1
End If
Next
If Cant > 0 And cnt2 > 0 Then
Porcentaje = Cant / cnt2
End If
Else
For i = 1 To cnt2
If Mid(ProveedEnExist, i, 1) = Mid(EntDeProveed, i, 1) Then
Cant = Cant + 1
End If
Next
If Cant > 0 And cnt1 > 0 Then
Porcentaje = Cant / cnt1
End If
End If
Similitud = Format(Round(Porcentaje, 2), "0.00%")
If Similitud = "100,00%" Then
MsgBox "El Proveedor: " & EntDeProveed & " Ya Existe", vbInformation, _
"Proveedor Existe"
Target = Empty
Exit Sub
Luego de enviar la consulta, he ubicado tu enlace “http://miguelmaresmahurtado.com/index.php/2016/03/14/porcentaje-de-similitud-entre-dos-textos/ “, exactamente lo que necesitaba.
Esto lo imagino como obtener la repuesta antes de consulta.
Gracias
claro esta lo adapte a mi necesidad te muestro:
Dim cnt1, cnt2, Cant, i As Integer, Porcentaje As Double
Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Cells.Count > 1 Then
Exit Sub
End If
UltCelda = Cells(Rows.Count, 1).End(xlUp).Row - 1
For CellsEnd = 5 To UltCelda
ProveedEnExist = Trim(Replace(ProveedEnExist, " ", ""))
EntDeProveed = Trim(Replace(EntDeProveed, " ", ""))
ProveedEnExist = Cells(CellsEnd, 1)
EntDeProveed = Target
cnt1 = Len(ProveedEnExist)
cnt2 = Len(EntDeProveed)
Cant = 0
Porcentaje = 0
If cnt1 <= cnt2 Then
For i = 1 To cnt1
If Mid(ProveedEnExist, i, 1) = Mid(EntDeProveed, i, 1) Then
Cant = Cant + 1
End If
Next
If Cant > 0 And cnt2 > 0 Then
Porcentaje = Cant / cnt2
End If
Else
For i = 1 To cnt2
If Mid(ProveedEnExist, i, 1) = Mid(EntDeProveed, i, 1) Then
Cant = Cant + 1
End If
Next
If Cant > 0 And cnt1 > 0 Then
Porcentaje = Cant / cnt1
End If
End If
Similitud = Format(Round(Porcentaje, 2), "0.00%")
If Similitud = "100,00%" Then
MsgBox "El Proveedor: " & EntDeProveed & " Ya Existe", vbInformation, _
"Proveedor Existe"
Target = Empty
Exit Sub
