Prev: coverting iWord.pages file
Next: Word.ActiveDocument.AttachedTemplate.Saved = True - gives "Type Mismatch" error
From: David Turner on 4 Feb 2010 06:58
I cobble this together no idea where to go, if anywhere(!), from here:

Sub LongestMatch()
Dim strArray1() As String
Dim strArray2() As String
Dim string1 As String
Dim string2 As String
Dim i As Integer
Dim j As Integer
Dim m As Integer
Dim n As Integer


string1 = "quick red fox jumped"
string2 = "red fox stood"

For m = 0 To UBound(Split(string1, " ")) - 1
ReDim Preserve strArray1(m)
strArray1(m) = Split(string1, " ")(m)
'MsgBox strArray1(m)
Next

For n = 0 To UBound(Split(string2, " ")) - 1
ReDim Preserve strArray2(n)
strArray2(n) = Split(string2, " ")(n)
'MsgBox strArray2(n)
Next

For m = 0 To UBound(strArray1)
For n = 0 To UBound(strArray2)
If strArray1(m) = strArray2(n) Then
MsgBox strArray1(m) ' don't know what to do next
ElseIf strArray1(m) <> strArray2(n) Then
MsgBox strArray2(n) ' don't know what to do next
End If
Next
Next

End Sub
From: Office PC Developer on 4 Feb 2010 15:28
This should do the trick...

Option Explicit

Public Function Main()

Dim aStr As String, bStr As String
aStr = "The quick red fox jumped over the lazy brown cow"
bStr = "The quick red fox just stood there"

Dim longestPhrases As Collection, longPhrase As Variant
Set longestPhrases = FindLongestMatchingPhrase(aStr, bStr)
For Each longPhrase In longestPhrases
Debug.Print "Longest Matching Phrase: " & longPhrase
Next

End Function

Public Function FindLongestMatchingPhrase(aStr As String, bStr As String) As
Collection

Dim longestPhrases As Collection
Set longestPhrases = New Collection

Dim aWords As Variant, bWords As Variant
aWords = Split(aStr, " ")
bWords = Split(bStr, " ")

Dim aPhrases As Collection, bPhrases As Collection
Set aPhrases = BuildPhrases(aWords)
Set bPhrases = BuildPhrases(bWords)

Dim curPhrase As Variant, longestPhraseLen As Integer
longestPhraseLen = 0
For Each curPhrase In aPhrases
If (FoundInOtherPhrases(curPhrase, bPhrases)) Then
If (Len(curPhrase) > longestPhraseLen) Then
longestPhraseLen = Len(curPhrase)
Set longestPhrases = New Collection
AddDistinctPhrase curPhrase, longestPhrases
ElseIf (Len(curPhrase) = longestPhraseLen) Then
AddDistinctPhrase curPhrase, longestPhrases
End If
End If
Next
For Each curPhrase In bPhrases
If (FoundInOtherPhrases(curPhrase, aPhrases)) Then
If (Len(curPhrase) > longestPhraseLen) Then
longestPhraseLen = Len(curPhrase)
Set longestPhrases = New Collection
AddDistinctPhrase curPhrase, longestPhrases
ElseIf (Len(curPhrase) = longestPhraseLen) Then
AddDistinctPhrase curPhrase, longestPhrases
End If
End If
Next

Set FindLongestMatchingPhrase = longestPhrases

End Function

Public Function BuildPhrases(wordList As Variant) As Collection

Dim phrases As Collection
Set phrases = New Collection

Dim firstIndex As Integer, secondIndex As Integer, curPhrase As Variant
For firstIndex = 0 To UBound(wordList)
curPhrase = ""
For secondIndex = firstIndex To UBound(wordList)
If (secondIndex > firstIndex) Then
curPhrase = curPhrase & " "
End If
curPhrase = curPhrase & wordList(secondIndex)
AddDistinctPhrase curPhrase, phrases
Next
Next

Set BuildPhrases = phrases

End Function

Public Sub AddDistinctPhrase(curPhrase As Variant, phrases As Collection)

On Error GoTo NotFound
Dim existingPhrase As Variant
existingPhrase = phrases(curPhrase)
Exit Sub

NotFound:
phrases.Add Key:=curPhrase, Item:=curPhrase
Exit Sub

End Sub

Public Function FoundInOtherPhrases(curPhrase As Variant, phrases As
Collection) As Boolean

On Error GoTo NotFound
Dim existingPhrase As Variant
existingPhrase = phrases(curPhrase)
FoundInOtherPhrases = True
Exit Function

NotFound:
FoundInOtherPhrases = False
Exit Function

End Function


"David Turner" wrote:

> The problem seems relatively straightward to the human eye but I imagine it's
> quite difficult to do in VBA without prior knowledge of what the strings
> contain.
> If I have two strings like:
> The quick red fox jumped over the lazy brown cow
> The quick red fox just stood there
> How would I compare them and identify "quick red fox" as the longest common
> sub-string?
> I suppose I would have to start by reading one of the strings into an array
> and comparing its elements against the second string? Or somehow use the
> Filter function to send the matching items to another array? But then I can
> only seem to be able compare each element against one word ("quick", "red" or
> "fox") which I would have to know in advance.
> There's no doubt some better way.
> Any advice greatly appreciated.
>
> Sub CompareStrings()
> Dim Array1() As String
> Dim string1 As String
> Dim string2 As String
> Dim InString() As String
> Dim i As Integer
> Dim j As Integer
>
> string1 = "The quick red fox jumped over the lazy brown cow"
> string2 = "The quick red fox just stood there"
>
> For i = 0 To UBound(Split(string1, " ")) - 1
> ReDim Preserve Array1(i)
> Array1(i) = Split(string1, " ")(i)
> 'MsgBox Array1(i)
> Next
>
> InString = Filter(Array1, "red", True)
>
> For j = 0 To UBound(InString)
> MsgBox InString(j)
> Next j
>
> End Sub
From: David Turner on 4 Feb 2010 18:01
Awesome! Only takes a second even with quite long strings. Will do my best to
try and understand the code. Many thanks.

"Office PC Developer" wrote:

> This should do the trick...
>
> Option Explicit
>
> Public Function Main()
>
> Dim aStr As String, bStr As String
> aStr = "The quick red fox jumped over the lazy brown cow"
> bStr = "The quick red fox just stood there"
>
> Dim longestPhrases As Collection, longPhrase As Variant
> Set longestPhrases = FindLongestMatchingPhrase(aStr, bStr)
> For Each longPhrase In longestPhrases
> Debug.Print "Longest Matching Phrase: " & longPhrase
> Next
>
> End Function
>
> Public Function FindLongestMatchingPhrase(aStr As String, bStr As String) As
> Collection
>
> Dim longestPhrases As Collection
> Set longestPhrases = New Collection
>
> Dim aWords As Variant, bWords As Variant
> aWords = Split(aStr, " ")
> bWords = Split(bStr, " ")
>
> Dim aPhrases As Collection, bPhrases As Collection
> Set aPhrases = BuildPhrases(aWords)
> Set bPhrases = BuildPhrases(bWords)
>
> Dim curPhrase As Variant, longestPhraseLen As Integer
> longestPhraseLen = 0
> For Each curPhrase In aPhrases
> If (FoundInOtherPhrases(curPhrase, bPhrases)) Then
> If (Len(curPhrase) > longestPhraseLen) Then
> longestPhraseLen = Len(curPhrase)
> Set longestPhrases = New Collection
> AddDistinctPhrase curPhrase, longestPhrases
> ElseIf (Len(curPhrase) = longestPhraseLen) Then
> AddDistinctPhrase curPhrase, longestPhrases
> End If
> End If
> Next
> For Each curPhrase In bPhrases
> If (FoundInOtherPhrases(curPhrase, aPhrases)) Then
> If (Len(curPhrase) > longestPhraseLen) Then
> longestPhraseLen = Len(curPhrase)
> Set longestPhrases = New Collection
> AddDistinctPhrase curPhrase, longestPhrases
> ElseIf (Len(curPhrase) = longestPhraseLen) Then
> AddDistinctPhrase curPhrase, longestPhrases
> End If
> End If
> Next
>
> Set FindLongestMatchingPhrase = longestPhrases
>
> End Function
>
> Public Function BuildPhrases(wordList As Variant) As Collection
>
> Dim phrases As Collection
> Set phrases = New Collection
>
> Dim firstIndex As Integer, secondIndex As Integer, curPhrase As Variant
> For firstIndex = 0 To UBound(wordList)
> curPhrase = ""
> For secondIndex = firstIndex To UBound(wordList)
> If (secondIndex > firstIndex) Then
> curPhrase = curPhrase & " "
> End If
> curPhrase = curPhrase & wordList(secondIndex)
> AddDistinctPhrase curPhrase, phrases
> Next
> Next
>
> Set BuildPhrases = phrases
>
> End Function
>
> Public Sub AddDistinctPhrase(curPhrase As Variant, phrases As Collection)
>
> On Error GoTo NotFound
> Dim existingPhrase As Variant
> existingPhrase = phrases(curPhrase)
> Exit Sub
>
> NotFound:
> phrases.Add Key:=curPhrase, Item:=curPhrase
> Exit Sub
>
> End Sub
>
> Public Function FoundInOtherPhrases(curPhrase As Variant, phrases As
> Collection) As Boolean
>
> On Error GoTo NotFound
> Dim existingPhrase As Variant
> existingPhrase = phrases(curPhrase)
> FoundInOtherPhrases = True
> Exit Function
>
> NotFound:
> FoundInOtherPhrases = False
> Exit Function
>
> End Function
>
>
> "David Turner" wrote:
>
> > The problem seems relatively straightward to the human eye but I imagine it's
> > quite difficult to do in VBA without prior knowledge of what the strings
> > contain.
> > If I have two strings like:
> > The quick red fox jumped over the lazy brown cow
> > The quick red fox just stood there
> > How would I compare them and identify "quick red fox" as the longest common
> > sub-string?
> > I suppose I would have to start by reading one of the strings into an array
> > and comparing its elements against the second string? Or somehow use the
> > Filter function to send the matching items to another array? But then I can
> > only seem to be able compare each element against one word ("quick", "red" or
> > "fox") which I would have to know in advance.
> > There's no doubt some better way.
> > Any advice greatly appreciated.
> >
> > Sub CompareStrings()
> > Dim Array1() As String
> > Dim string1 As String
> > Dim string2 As String
> > Dim InString() As String
> > Dim i As Integer
> > Dim j As Integer
> >
> > string1 = "The quick red fox jumped over the lazy brown cow"
> > string2 = "The quick red fox just stood there"
> >
> > For i = 0 To UBound(Split(string1, " ")) - 1
> > ReDim Preserve Array1(i)
> > Array1(i) = Split(string1, " ")(i)
> > 'MsgBox Array1(i)
> > Next
> >
> > InString = Filter(Array1, "red", True)
> >
> > For j = 0 To UBound(InString)
> > MsgBox InString(j)
> > Next j
> >
> > End Sub
First  |  Prev  | 
Pages: 1 2 3
Prev: coverting iWord.pages file
Next: Word.ActiveDocument.AttachedTemplate.Saved = True - gives "Type Mismatch" error