Re: Find words within range of other word in string?????????


"vonClausowitz" <vonclausowitz@xxxxxxxxx> wrote

Additional question:
Can it also return the largest gap between two words?

You might be able to modify this, it stores the word (in list) and
its word count (in found). With those you could calculate how far
any one word is from any other word. (Min or Max, whatever)

As is, it only returns true if any two words are near each other:

HTH
LFS

Option Explicit

Private Sub Form_Load()
Dim text As String

text = "One Two Three Four Five Six"

' Case sensative - test as-is
Debug.Print Proximity(text, 2, "One", "Four") ' False
Debug.Print Proximity(text, 3, "One", "Four") ' True
' Case insensative - convert all to lower case
Debug.Print Proximity(LCase$(text), 2, "one", "four") ' False
Debug.Print Proximity(LCase$(text), 3, "one", "four") ' True

'Rejection - doesn't count words near themselves
text = "reject the reject wording"
Debug.Print Proximity(text, 10, "reject", "reject") ' False
Debug.Print Proximity(text, 10, "reject", "wording") ' True

End Sub



Private Function Proximity(ByVal text As String, Range As Long, _
ParamArray Words()) As Boolean
' Returns True if any word in 'Words' is within 'Range' words of
' any other word in 'Words'.
Dim pos&, idx&, cnt&, itm
Dim test As String
Dim match As Collection
Dim found As Collection
Dim list As Collection

Set match = New Collection
Set found = New Collection
Set list = New Collection

' Buffer the last word
text = text & " "

' Build look-up table
On Error Resume Next
For Each itm In Words
match.Add 1, itm
Next

On Error GoTo Skip

For idx = 1 To Len(text)
' Find words
Select Case Mid$(text, idx, 1)
Case "a" To "z", "A" To "Z"
If pos = 0 Then pos = idx
Case Else
If pos > 0 Then
' Got a word
test = Mid$(text, pos, idx - pos)
cnt = cnt + 1
' Look it up (will error (to Skip:) if no match found)
If match(test) > 0 Then
' Store word & count on match
list.Add test
found.Add cnt
End If
Skip:
If Err.Number Then Resume Skipped
Skipped:
pos = 0
End If
End Select
Next


' Check ranges
For idx = 1 To found.Count - 1
' Check range
If (found(idx + 1) - found(idx)) <= Range Then
' Reject words next to themselves
If list(idx + 1) <> list(idx) Then
Proximity = True
Exit Function
End If
End If
Next

End Function




.

Relevant Pages