0

I've the following Excel data:

     A              B              C
  + ------------   -------------   -----------------
1 | WORD           WORD MIX        MATCH TEXT RESULT
2 | somewordsome   emsomordsowe    ...
3 | anotherword    somethingelse   ...
4 | ...            ...             ...

I'd like to:

  • Firstly, get an array, say ArrayOfGroups, by splitting the string in the A2 cell in unique groups of 2 to 12 adjacent chars (note: 2 is the minimum number of chars to form a group; 12 is the total number of the word's chars) i.e. the groups of 2 chars would be so, om, me, ew, wo, or, rd, ds (note: the last so, om and me groups are excluded because they are repeated); the groups of 3 chars would be som, ome, mew, ewo, wor, ord, rds, dso (last som and ome excluded); the groups of 4 chars would be some, omew, mewo, ewor, word, ords, rdso, dsom; ... and so on until the full string somewordsome.

  • Then, iterate the above-mentioned ArrayOfGroups to check if each of its element is a substring of the B2 cell and return a new array, say ArrayOfMatches, containing all the elements (the characters "group names") that are substrings of B2 and the number of occurrences found in B2.

  • Finally, output in the C2 cell a sentence built using the ArrayOfMatches data that says something like this:

    2 matches for so, 1 match for som and rd

Probably there are other and better approaches to compute the above sentence that is the final result wanted. Maybe I need to use a User Defined Function... but I never made it.

Is there someone that could give help?

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
Backo
  • 18,291
  • 27
  • 103
  • 170

1 Answers1

1

May try something like this

Code edited to avoid counting for same substring found multiple times.

Sub test2()
Dim Xstr As String, Ystr As String
Xstr = "somewordsome"
Ystr = "emsomordsowe"
MsgBox Xmatch2(Xstr, Ystr)
End Sub
Function Xmatch2(Xstr As String, Ystr As String) As String
Dim XSubStr As String, YSubStr As String
Dim xLn As Integer, yLn As Integer
Dim XArr As Variant, LnSubStr As Integer
Dim Rslt As String, Cnt As Integer
Dim Xrr() As Variant, Xcnt As Integer, Chk As Boolean
Rslt = "'"

xLn = Len(Xstr)
yLn = Len(Ystr)

    For LnSubStr = 2 To xLn        'length of substring
    Xcnt = 0
    ReDim XArr(1 To 1)
         For Y = 1 To xLn
         XSubStr = ""
         Xcnt = Xcnt + 1
         ReDim Preserve XArr(1 To Xcnt)
         If Y + LnSubStr - 1 <= xLn Then XSubStr = Mid(Xstr, Y, LnSubStr)
         XArr(Xcnt) = XSubStr
            Chk = False
            For i = 1 To Xcnt - 1
                If XArr(i) = XSubStr Then
                Chk = True
                Exit For
                End If
            Next

            If XSubStr <> "" And Chk = False Then
                Cnt = 0
                ReDim Preserve XArr(1 To Xcnt)
                For Z = 1 To yLn
                YSubStr = ""
                If Z + LnSubStr - 1 <= yLn Then YSubStr = Mid(Ystr, Z, LnSubStr)
                If YSubStr = XSubStr Then Cnt = Cnt + 1
                Next
            If Cnt > 0 Then Rslt = Rslt & Cnt & " Matches for " & XSubStr & ","
            End If
         Next
    Next

Debug.Print Rslt
Xmatch2 = Rslt
End Function
Ahmed AU
  • 2,757
  • 2
  • 6
  • 15