Hola a todos, os presento mi utlima funcion : Check_Similar_Words
Donde x es la cantidad de digitos de la palabra y n los digitos en los que se quiere separar esa palabra...
Comprobaria si las palabras de la cadena contienen algunos de estos trozos y las guarda en mi Collection.
Lo divertido es que segun el número de coincidencias que pongamos, la busqueda sera mas o menos estricta.
Y obtengo esto:
En cambio si en vez de 3 pongo 4 en la llamada la busqueda de palabras similares se vuelve más extricta y obtendria esto:
Espero que os haya gustado!
Salu2!
- ¿Que hace?
Busca palabras similares en una cadena de texto, obtendrias un resultado similar al tipico de Google : "Quizas quiso decir... " - ¿Como funciona?
Lo que hace es alamcenar en un array todas las palabras que encuentre en la cadena a analizar, una vez aqui, descompongo la palabra que se busca en las partes correspondientes a el número de coincidencias que queramos buscar, os voy a poner un ejemplo:
Supongamos que se desea buscar la palabra "mañana", y indicamos a la funcion que busque palabras similares con 3 coincidencias, entonces se partiria la palabra a buscar de esta manera:
CitarmañLa formula para sacar el numero de fragmentos es esta:
aña
ñan
ana
Código [Seleccionar]
(x - n) + 1Donde x es la cantidad de digitos de la palabra y n los digitos en los que se quiere separar esa palabra...
Comprobaria si las palabras de la cadena contienen algunos de estos trozos y las guarda en mi Collection.
Lo divertido es que segun el número de coincidencias que pongamos, la busqueda sera mas o menos estricta.
- Bueno aqui os dejo el codigo:
Código (vb) [Seleccionar]
'==================================================================================================
' º Function : Check_Similar_Words
' º Version : 1.2
' º Author : Mr.Frog ©
' º Country : Spain
' º Mail : vbpsyke1@mixmail.com
' º Twitter : http://twitter.com/#!/PsYkE1
' º Recommended Websites :
' http://visual-coders.com.ar
' http://InfrAngeluX.Sytes.Net
'==================================================================================================
Option Explicit
Option Base 0
Private Declare Function lstrcmpi Lib "kernel32" Alias "lstrcmpiA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Function Check_Similar_Words(ByVal sStringToAnalyze As String, ByVal sWord As String, ByVal bvComparationLevel As Byte) As Collection
Const sNullChars As String = ".,"
Dim cTemp As New Collection
Dim sCompareWord() As String
Dim sTextWord() As String
Dim sActualWord As String
Dim lTotalCompWords As Long
Dim lTotalWords As Long
Dim lLenWord As Long
Dim Q As Long
Dim G As Long
If CBool(bvComparationLevel) Then
lLenWord = Len(sWord)
If (lLenWord > 2) And (Len(sStringToAnalyze) > lLenWord) Then
If (bvComparationLevel < lLenWord) Then
If Not (InStrB(sWord, vbNewLine)) Then
G = 1
lTotalCompWords = (lLenWord - bvComparationLevel) + 1
ReDim sCompareWord(lTotalCompWords) As String
Do Until Q = lTotalCompWords
sCompareWord$(Q) = Mid$(sWord, G, bvComparationLevel)
G = G + 1
Q = Q + 1
Loop
sStringToAnalyze = Replace$(sStringToAnalyze, vbNewLine, Space$(1))
sTextWord() = Split(sStringToAnalyze, Space$(1))
lTotalWords = UBound(sTextWord)
lTotalCompWords = lTotalCompWords - 1
For Q = 0 To lTotalWords
sActualWord = sTextWord(Q)
If Len(sActualWord) >= bvComparationLevel Then
For G = 0 To lTotalCompWords
If CBool(lstrcmpi(sWord, sActualWord)) Then
If InStrB(1, sActualWord, sCompareWord(G), vbTextCompare) Then
If InStrB(sNullChars$, Right$(sActualWord, 1)) Then
sActualWord = Left$(sActualWord, Len(sActualWord) - 1)
End If
On Error Resume Next
cTemp.Add sActualWord, sActualWord
End If
End If
Next G
End If
Next Q
Set Check_Similar_Words = cTemp
End If
End If
End If
End If
End Function- Un ejemplo práctico:
Tengo en un TextBox(llamado Text1) esto:Citar
La inspiración de Cervantes para componer esta obra vino, al parecer, del llamado Entremés de los romances, que era de fecha anterior (aunque esto es discutido). Su argumento ridiculiza a un labrador que enloquece creyéndose héroe de romances. El labrador abandonó a su mujer, y se echó a los caminos, como hizo Don Quijote. Este entremés posee una doble lectura: también es una crítica a Lope de Vega; quien, después de haber compuesto numerosos romances autobiográficos en los que contaba sus amores, abandonó a su mujer y marchó a la Armada Invencible. Es conocido el interés de Cervantes por el Romancero y su resentimiento por haber sido echado de los teatros por el mayor éxito de Lope de Vega, así como su carácter de gran entremesista. Un argumento a favor de esta hipótesis sería el hecho de que, a pesar de que el narrador nos dice que Don Quijote ha enloquecido a causa de la lectura de libros de caballerías, durante su primera salida recita romances constantemente, sobre todo en los momentos de mayor desvarío. Por todo ello, podría ser una hipótesis verosímil. A este influjo se agregó el de Tirante el Blanco de Joanot Martorell, el del Morgante de Luigi Pulci y el del Orlando Furioso de Ludovico Ariosto.
Para ver un ejemplo:
Código (vb) [Seleccionar]
Private Sub Form_Load()
Dim vItem As Variant
Debug.Print "--------------->"; Time$
For Each vItem In Check_Similar_Words(Text1.Text, "argumento", 4)
Debug.Print vItem
Next vItem
End SubY obtengo esto:
Citar
Entremés
numerosos
resentimiento
entremesista
constantemente
momentos
En cambio si en vez de 3 pongo 4 en la llamada la busqueda de palabras similares se vuelve más extricta y obtendria esto:
Citar
resentimiento
constantemente
momentos
Espero que os haya gustado!
Salu2!
![:-\](https://forum.elhacker.net/Smileys/navidad/undecided.gif ":-\")
, pero eso no es lo que busco, es con una cadena que ya contiene simbolos... 
