Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Visual Basic para Aplicaciones » Comparación aproximada

Visual Basic para Aplicaciones - Comparación aproximada

Life is soft - evento anual de software empresarial
Volver
Nuevo Tema
<<>>
 
Vista:

Comparación aproximada

Publicado por BlackWolf (5 intervenciones) el 19/07/2011 05:52:24
Hola, estoy desarrollando una programa para actualizar una base de Access desde Excel. Hasta ahí todo bien, el tema es que tengo que validar datos ingresados manualmente en una planilla, y como estamos hablando de varias decenas de registros por vez es bastante engorroso si lo hago "rígido", es decir, si por ejemplo, el nombre de un proveedor ingresado a mano no coincide con el nombre que corresponde en la tabla de Access. Resolví que tenía que implementar una especie de "comparación aproximada", es decir, algo así como lo que hace Google cuando dice "Tal vez quiso decir...". Por eso estoy intentando desarrollar una función de vba a la que le pase dos cadenas de texto para que las compare y un porcentaje de exactitud, y aunque funciona mas o menos, no me termina de convencer. Trabaja evaluando porciones pequeñas de texto, la suma de los valores Ascii y todo un juego de porcentajes ponderados que medio se me fue de las manos.

Paso un ejemplo: El proveedor es "JUANITO SRL" y yo ingreso "JUANCITO SRL", la función al comparar estas dos cadenas con un porcentaje de aproximación de, digamos un 80%, debería devolver TRUE, es decir, son "parecidas", y así el usuario podría seleccionar el nombre correcto de una lista de "aproximados".


Quería saber si alguien de ustedes se encontró antes con algún desafío parecido, y si tienen algún consejo para esto.

Grazie!

BlackWolf
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 1.134
Oro
Ha mantenido su posición en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Comparación aproximada

Publicado por Antoni Masana (502 intervenciones) el 19/07/2011 07:56:59
Una opción a priori más simple seria mostrar una lista desplegable con los nombres de los Proveedores y que el usuario busque el que desea.

Otra opción un poco más currado es con la misma lista de la opción anterior hacer que mientras el usuario va escribiendo el nombre se busque en la lista el que mas se acerca a lo que ha escrito.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Comparación aproximada

Publicado por Ing. Zeus Alberto Paez Renteria (26 intervenciones) el 26/07/2011 17:38:37
Bueno si es lo que quieres se me ocurre la siguiente idea solo traducela a codigo

Por ejemplo

Hola

H= 25%
o=25%
l=25%
a=25%

El un true si es similar a mas del 60 % de los textos.

Hola vs Hoal

Letra por letra se recorre el Hola y se busca If Instrrev("Hola", "H")>0 then


Quiza por orden puedes dar un porcentaje no se quiza de un 15% si las posiciones de los textos hacen match con la posicion del caracter por ejemplo Hola = 85% dividido entre 4, el 15% seria 15%/4, si la posicion de la H es igual en Hola que en Hoal, entonces tendria 21.25% porque la H esta en el texto, luego 3.75% porque esta en la misma posicion.

Tons Probabilidad de hacer match seria de 25% por el primer caracter.

Creo que la funcion no seria muy complicada de desarrollar, si tu Probabilidad calculada llamemosle PC es >= 75% mostrar la palabra de la bases de datos en un Form1 como Tal vez quiso decir "Hola" ?

En este caso como todas las letras aparecen pero dos estan invertidas pues tu PC va a ser igual a
96.25%, es un ejemplo que no esta muy pulido pero es una idea que complementada con unas horas o minutos puede generar un buen algoritmo para detectar las palabras parecidas.

Saludos y espero te sirva
Att. Ing. Zeus Alberto Paez Renteria
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Comparación aproximada

Publicado por BlackWolf (5 intervenciones) el 29/07/2011 18:46:12
Gracias por las respuestas!

Al final me corrían un poco los tiempos y terminé implementando algo que resultó ser bastante parecido en resultado a lo que dices, Zeus. Utilizo dos comparaciones diferentes, una por la suma de los valores Ascii para detectar inversiones de caracteres y otra funcion recursiva que compara una cadena contra otra tomando fragmentos de texto cada vez más pequeños, hasta 4 caracteres. Estas me devuelven dos porcentajes que luego pondero, dándole mas importancia a la segunda, y me queda al final un número puedo evaluar dentro de márgenes variables de concordancia definidos por el usuario. Lo bueno es que funciona. Cuando tenga un rato para estandarizarla un poco y ordenarla la voy a subir por si alguien tiene algún problema similar.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Comparación aproximada

Publicado por Daniel (2 intervenciones) el 19/05/2013 08:27:18
Hola este problema es muy comentado y me quebre la cabeza buscando algo que me funcionara y bueno al final veo las fechas de los comentarios y deduzco que cada quien encontró la solución y se la guardo, este es mi aporte.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Public Function BuscarTexto(texto1 As String, texto2 As String) As Integer
'Función para buscar palabras parecidas entre dos cadenas de texto.

'Uso: BuscarTexto(Texto a buscar, Texto fuente)

'valor devuelto integer con porcentaje del 100 al 0 según coincidencia

'DigitalBlood 2013 DcM.

'Código para VB6 generado por mi cerebro en uno de mis días de inspiración.

'Uso y modificación Libre pero compartan las modificaciones.

Dim EspacioDetectado As Integer
Dim TextoaBuscar As New Collection
Dim TextoPrincipal As New Collection
Dim TextoaEliminar As Integer
Dim iTEMACTUAL As Integer
Dim PalabrasEncontradas As Integer
Dim TotalPalabrasEncontradas As Integer
 
Do Until Len(texto1) = 0
EspacioDetectado = InStr(texto1, " ") - 1
If EspacioDetectado <> -1 Then
TextoPrincipal.Add Left(texto1, EspacioDetectado)
Else
TextoPrincipal.Add texto1
texto1 = ""
Exit Do
End If
iTEMACTUAL = TextoPrincipal.Count
TextoaEliminar = Len(texto1) - EspacioDetectado
texto1 = LTrim(Right(texto1, TextoaEliminar))
Loop
 
Do Until Len(texto2) = 0
EspacioDetectado = InStr(texto2, " ") - 1
If EspacioDetectado <> -1 Then
TextoaBuscar.Add Left(texto2, EspacioDetectado)
Else
TextoaBuscar.Add texto2
texto2 = ""
Exit Do
End If
iTEMACTUAL = TextoaBuscar.Count
TextoaEliminar = Len(texto2) - EspacioDetectado
texto2 = LTrim(Right(texto2, TextoaEliminar))
Loop
 
PalabrasEncontradas = 0
 
 
For a = 1 To TextoPrincipal.Count
    For b = 1 To TextoaBuscar.Count
PalabrasEncontradas = InStr(1, TextoPrincipal.Item(a), TextoaBuscar.Item(b), vbTextCompare)
    TotalPalabrasEncontradas = TotalPalabrasEncontradas + PalabrasEncontradas
    Next
Next
 
If TextoPrincipal.Count <> 0 Then
Dim VALOR1 As Integer
Dim VALOR2 As Integer
VALOR1 = TotalPalabrasEncontradas * 100
VALOR2 = VALOR1 / TextoPrincipal.Count
BuscarTexto = VALOR2
End If
End Function
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Comparación aproximada

Publicado por Daniel (2 intervenciones) el 19/05/2013 20:08:34
le hice unos cambios por que aún tiene bugs pero vamos saliendo, esto lo diseñe porque busco nombres y domicilios de una hoja de excel que coincidan con mi base de datos.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
Public Function BuscarTexto(texto1 As String, texto2 As String) As Integer
'Función para buscar palabras parecidas entre dos cadenas de texto.

'Uso: BuscarTexto(Texto a buscar, Texto fuente)

'valor devuelto integer con porcentaje del 100 al 0 según coincidencia

'DigitalBlood 2013 DcM.

'Código para VB6 generado por mi cerebro en uno de mis días de inspiración.

'Uso y modificación Libre pero compartan las modificaciones.

Dim EspacioDetectado As Integer
Dim TextoaBuscar As New Collection
Dim TextoPrincipal As New Collection
Dim TextoaEliminar As Integer
Dim iTEMACTUAL As Integer
Dim PalabrasEncontradas As Integer
Dim TotalPalabrasEncontradas As Integer
Dim TextoA As String
Dim TextoB As String
 
    If Len(texto1) < Len(texto2) Then  ' esto lo puse para determinar la búsqueda

        TextoA = texto1                             ' el texto mas pequeño es buscado en el mas grande

        TextoB = texto2
            Else
        TextoA = texto2
        TextoB = texto1
    End If
 
Do Until Len(TextoA) = 0
EspacioDetectado = InStr(TextoA, " ") - 1
If EspacioDetectado <> -1 Then
 
 ' cuando la gente captura el  nombre de una persona en la base de datos generalmente usan  

' usan letras como Ing. fabian romo hernandez  en lugar de Fabian romo hernandez o 

'Sra. ma. de los angeles rubio en lugar de Maria de los angeles rubio

'con esta función elimino las palabras de menos de tres letras de la busqueda respetando

´los numeros
 
    If IsNumeric(Left(TextoA, EspacioDetectado)) Then
        TextoPrincipal.Add Left(TextoA, EspacioDetectado)
        Else
             If Len(Left(TextoA, EspacioDetectado)) > 3 Then
             TextoPrincipal.Add Left(TextoA, EspacioDetectado)
             End If
    End If
Else
    If IsNumeric(TextoA) Then
        TextoPrincipal.Add TextoA
        Else
            If Len(TextoA) > 3 Then
            TextoPrincipal.Add TextoA
            End If
    End If
TextoA = ""
Exit Do
End If
iTEMACTUAL = TextoPrincipal.Count
TextoaEliminar = Len(TextoA) - EspacioDetectado
TextoA = LTrim(Right(TextoA, TextoaEliminar))
Loop
 
Do Until Len(TextoB) = 0
EspacioDetectado = InStr(TextoB, " ") - 1
If EspacioDetectado <> -1 Then
        If IsNumeric(Left(TextoB, EspacioDetectado)) Then
        TextoaBuscar.Add Left(TextoB, EspacioDetectado)
        Else
            If Len(Left(TextoB, EspacioDetectado)) > 3 Then
            TextoaBuscar.Add Left(TextoB, EspacioDetectado)
            End If
       End If
Else
    If IsNumeric(TextoB) Then
        TextoaBuscar.Add TextoB
        Else
            If Len(TextoB) > 3 Then
            TextoaBuscar.Add TextoB
            End If
    End If
TextoB = ""
Exit Do
End If
iTEMACTUAL = TextoaBuscar.Count
TextoaEliminar = Len(TextoB) - EspacioDetectado
TextoB = LTrim(Right(TextoB, TextoaEliminar))
Loop
 
PalabrasEncontradas = 0
 
 
For a = 1 To TextoPrincipal.Count
    For b = 1 To TextoaBuscar.Count
PalabrasEncontradas = InStr(1, TextoPrincipal.Item(a), TextoaBuscar.Item(b), vbTextCompare)
'MsgBox TextoPrincipal.Item(a) & "/" & TextoaBuscar.Item(b)

    TotalPalabrasEncontradas = TotalPalabrasEncontradas + PalabrasEncontradas
    Next
Next
 
If TextoPrincipal.Count <> 0 Then
Dim VALOR1 As Integer
Dim VALOR2 As Integer
VALOR1 = TotalPalabrasEncontradas * 100
VALOR2 = VALOR1 / TextoPrincipal.Count
BuscarTexto = VALOR2
End If
End Function
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Comparación aproximada

Publicado por josemaria (1 intervención) el 08/05/2014 20:44:28
Justo lo que estaba buscando, ahora lo pruebo a ver cómo va. También me hace falta comparar datos de una tabla con datos introducidos a mano, y si coinciden tomar unas decisiones.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Comparación aproximada

Publicado por Kipplecraft (1 intervención) el 03/04/2017 22:05:52
Fussy Lookup
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar