Return True if there are any common letters between two strings
-
- PlatinumLounger
- Posts: 4931
- Joined: 31 Aug 2016, 09:02
Return True if there are any common letters between two strings
Hello everyone
Suppose I have two strings "abcd" and "cfgh!!#v"
How can I return True here as there is the letter c is intersection in both strings?
Searching for the simplist approach and try to avoiding loops.
Thanks a lot.
Suppose I have two strings "abcd" and "cfgh!!#v"
How can I return True here as there is the letter c is intersection in both strings?
Searching for the simplist approach and try to avoiding loops.
Thanks a lot.
-
- Administrator
- Posts: 78558
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Return True if there are any common letters between two strings
I don't see how you could avoid using a loop - you'll need to look at individual characters.
Try this:
For efficiency, the code loops through the characters of the shortest string
Example usage:
This returns
On my computer, Common("abcd", "cfgh!!#v") takes 0.00000042 seconds, and Common("abcd", "efgh!!#v") takes 0.00000053 seconds.
Try this:
Code: Select all
Function Common(s1 As String, s2 As String) As Boolean
Dim n1 As Long, n2 As Long, i As Long
n1 = Len(s1)
n2 = Len(s2)
If n1 < n2 Then
For i = 1 To n1
If InStr(s2, Mid(s1, i, 1)) Then
Common = True
Exit Function
End If
Next i
Else
For i = 1 To n2
If InStr(s1, Mid(s2, i, 1)) Then
Common = True
Exit Function
End If
Next i
End If
End Function
Example usage:
Code: Select all
Sub Test()
Debug.Print Common("abcd", "cfgh!!#v")
Debug.Print Common("abcd", "efgh!!#v")
End Sub
Code: Select all
True
False
Best wishes,
Hans
Hans
-
- BronzeLounger
- Posts: 1499
- Joined: 28 Feb 2015, 13:11
- Location: Hof, Bayern, Germany
Re: Return True if there are any common letters between two strings
Here some ideas using Dictionaries.
They don't seem to be as quick as Hans macro
Alan
They don't seem to be as quick as Hans macro
Code: Select all
' https://eileenslounge.com/viewtopic.php?f=30&t=36382
Option Explicit
Private Declare Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
Private Const sCPURegKey = "HARDWARE\DESCRIPTION\System\CentralProcessor\0"
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Function MicroTimer() As Double
Dim cyTicks1 As Currency: Static cyFrequency As Currency
Let MicroTimer = 0
If cyFrequency = 0 Then getFrequency cyFrequency ' get ticks/sec
Call getTickCount(cyTicks1) ' get ticks
If cyFrequency Then Let MicroTimer = cyTicks1 / cyFrequency ' calc seconds
End Function
Sub Tests()
Debug.Print "ComonEileen (Alan)" ' ' For if no duplicates in either word
Dim TimIt As Double
Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "cfgh!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "efgh!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Debug.Print
Debug.Print "ComonEileen2 (Alan)" ' For if there might be duplicates in words
Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "cfgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "efgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Debug.Print
Debug.Print "CommonH ( Hans )"
Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "cfgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "efgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
End Sub
' For if no duplicates in either word
Sub Test1()
Debug.Print "ComonEileen (Alan)"
Dim TimIt As Double
Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "cfgh!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "efgh!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
End Sub
Function ComonEileen(s1 As String, s2 As String) As Boolean
Dim Dik As Scripting.Dictionary
Set Dik = New Scripting.Dictionary
Dim Cnt As Long
For Cnt = 1 To Len(s1 & s2)
Let Dik(Mid(s1 & s2, Cnt, 1)) = "Anything"
Next Cnt
If Len(Join(Dik.Keys(), "")) <> Len(s1 & s2) Then Let ComonEileen = True
End Function
' For if there might be duplicates in words
Sub Test2()
Debug.Print
Debug.Print "ComonEileen2 (Alan)"
Dim TimIt As Double
Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "cfgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "efgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
End Sub
Function ComonEileen2(s1 As String, s2 As String) As Boolean
Dim Dik As Scripting.Dictionary, Dik1 As Scripting.Dictionary, Dik2 As Scripting.Dictionary
Set Dik = New Scripting.Dictionary: Set Dik1 = New Scripting.Dictionary: Set Dik2 = New Scripting.Dictionary
Dim Cnt As Long
For Cnt = 1 To Len(s1)
Let Dik1(Mid(s1, Cnt, 1)) = "Anything"
Next Cnt
Let s1 = Join(Dik1.Keys(), "")
For Cnt = 1 To Len(s2)
Let Dik2(Mid(s2, Cnt, 1)) = "Anything"
Next Cnt
Let s2 = Join(Dik2.Keys(), "")
For Cnt = 1 To Len(s1 & s2)
Let Dik(Mid(s1 & s2, Cnt, 1)) = "Anything"
Next Cnt
If Len(Join(Dik.Keys(), "")) <> Len(s1 & s2) Then Let ComonEileen2 = True
End Function
Sub TestHans()
Debug.Print
Debug.Print "CommonH ( Hans )"
Dim TimIt As Double
Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "cfgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "efgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
End Sub
Function CommonH(s1 As String, s2 As String) As Boolean
Dim n1 As Long, n2 As Long, i As Long
n1 = Len(s1)
n2 = Len(s2)
If n1 < n2 Then
For i = 1 To n1
If InStr(s2, Mid(s1, i, 1)) Then
CommonH = True
Exit Function
End If
Next i
Else
For i = 1 To n2
If InStr(s1, Mid(s2, i, 1)) Then
CommonH = True
Exit Function
End If
Next i
End If
End Function
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also
You can find me at DocAElstein also
-
- PlatinumLounger
- Posts: 4931
- Joined: 31 Aug 2016, 09:02
Re: Return True if there are any common letters between two strings
Awesome my tutor. Thank you very much.
I thought it is possible to use the LIKE operator or using regex to do such a task.
I thought it is possible to use the LIKE operator or using regex to do such a task.
-
- Administrator
- Posts: 78558
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Return True if there are any common letters between two strings
I found another algorithm on Google, but although it was faster than Alan's ingenious solution, it was slower than the one I proposed.
Best wishes,
Hans
Hans
-
- PlatinumLounger
- Posts: 4931
- Joined: 31 Aug 2016, 09:02
Re: Return True if there are any common letters between two strings
Thanks a lot Mr. Alan, I didn't see your post as it was my sleep time.
Can you provide us with the algorithm you found Mr. Hans?
Can you provide us with the algorithm you found Mr. Hans?
-
- Administrator
- Posts: 78558
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Return True if there are any common letters between two strings
I modified the code found in Check if two strings have a common substring.
Best wishes,
Hans
Hans
-
- PlatinumLounger
- Posts: 4931
- Joined: 31 Aug 2016, 09:02
Re: Return True if there are any common letters between two strings
Thanks a lot. But I didn't find a VBA code at the link.
-
- Administrator
- Posts: 78558
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Return True if there are any common letters between two strings
No, I "translated" the Javascript code to VBA and modified it to handle more characters than just a-z.
Best wishes,
Hans
Hans
-
- BronzeLounger
- Posts: 1499
- Joined: 28 Feb 2015, 13:11
- Location: Hof, Bayern, Germany
Re: Return True if there are any common letters between two strings
Here I have added a couple of functions that use Dictionaries in a more conventional way, but they are all still quite a bit slower than Han's original offering
Code: Select all
' https://eileenslounge.com/viewtopic.php?f=30&t=36382
Option Explicit
Private Declare Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
Private Const sCPURegKey = "HARDWARE\DESCRIPTION\System\CentralProcessor\0"
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Function MicroTimer() As Double
Dim cyTicks1 As Currency: Static cyFrequency As Currency
Let MicroTimer = 0
If cyFrequency = 0 Then getFrequency cyFrequency ' get ticks/sec
Call getTickCount(cyTicks1) ' get ticks
If cyFrequency Then Let MicroTimer = cyTicks1 / cyFrequency ' calc seconds
End Function
Sub Tests()
Debug.Print
Debug.Print "Indiginus (Alan)"
Dim TimIt As Double
Let TimIt = MicroTimer
Debug.Print Indiginus("abcd", "cfgh!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print Indiginus("abcd", "efgh!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Debug.Print
Debug.Print "Indiginus2 (Alan)"
Let TimIt = MicroTimer
Debug.Print Indiginus2("abcd", "cfgh!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print Indiginus2("abcd", "efgh!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Debug.Print
Debug.Print "ComonEileen (Alan)" ' ' For if no duplicates in either word
Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "cfgh!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "efgh!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Debug.Print
Debug.Print "ComonEileen2 (Alan)" ' For if there might be duplicates in words
Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "cfgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "efgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Debug.Print
Debug.Print "CommonH ( Hans )"
Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "cfgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "efgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
End Sub
Function ComonEileen(s1 As String, s2 As String) As Boolean ' For if no duplicates in either word
Dim Dik As Scripting.Dictionary
Set Dik = New Scripting.Dictionary
Dim Cnt As Long
For Cnt = 1 To Len(s1 & s2)
Let Dik(Mid(s1 & s2, Cnt, 1)) = "Anything"
Next Cnt
If Len(Join(Dik.Keys(), "")) <> Len(s1 & s2) Then Let ComonEileen = True
End Function
Function Indiginus(s1 As String, s2 As String) As Boolean
Dim Dik As Scripting.Dictionary
Set Dik = New Scripting.Dictionary
Dim Cnt As Long
For Cnt = 1 To Len(s1)
Let Dik(Mid(s1, Cnt, 1)) = "Anything"
Next Cnt
For Cnt = 1 To Len(s2)
If Dik.Exists(Mid(s2, Cnt, 1)) Then Let Indiginus = True: Exit Function
Next Cnt
End Function
Function Indiginus2(s1 As String, s2 As String) As Boolean
Dim Dik As Scripting.Dictionary
Set Dik = New Scripting.Dictionary
Dim Cnt As Long
If Len(s1) < Len(s2) Then
For Cnt = 1 To Len(s1)
Let Dik(Mid(s1, Cnt, 1)) = "Anything"
Next Cnt
For Cnt = 1 To Len(s2)
If Dik.Exists(Mid(s2, Cnt, 1)) Then Let Indiginus2 = True: Exit Function
Next Cnt
Else
For Cnt = 1 To Len(s2)
Let Dik(Mid(s2, Cnt, 1)) = "Anything"
Next Cnt
For Cnt = 1 To Len(s1)
If Dik.Exists(Mid(s1, Cnt, 1)) Then Let Indiginus2 = True: Exit Function
Next Cnt
End If
End Function
Function ComonEileen2(s1 As String, s2 As String) As Boolean ' For if there might be duplicates in words
Dim Dik As Scripting.Dictionary, Dik1 As Scripting.Dictionary, Dik2 As Scripting.Dictionary
Set Dik = New Scripting.Dictionary: Set Dik1 = New Scripting.Dictionary: Set Dik2 = New Scripting.Dictionary
Dim Cnt As Long
For Cnt = 1 To Len(s1)
Let Dik1(Mid(s1, Cnt, 1)) = "Anything"
Next Cnt
Let s1 = Join(Dik1.Keys(), "")
For Cnt = 1 To Len(s2)
Let Dik2(Mid(s2, Cnt, 1)) = "Anything"
Next Cnt
Let s2 = Join(Dik2.Keys(), "")
For Cnt = 1 To Len(s1 & s2)
Let Dik(Mid(s1 & s2, Cnt, 1)) = "Anything"
Next Cnt
If Len(Join(Dik.Keys(), "")) <> Len(s1 & s2) Then Let ComonEileen2 = True
End Function
Function CommonH(s1 As String, s2 As String) As Boolean
Dim n1 As Long, n2 As Long, i As Long
n1 = Len(s1)
n2 = Len(s2)
If n1 < n2 Then
For i = 1 To n1
If InStr(s2, Mid(s1, i, 1)) Then
CommonH = True
Exit Function
End If
Next i
Else
For i = 1 To n2
If InStr(s1, Mid(s2, i, 1)) Then
CommonH = True
Exit Function
End If
Next i
End If
End Function
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also
You can find me at DocAElstein also
-
- 2StarLounger
- Posts: 102
- Joined: 04 Feb 2010, 22:44
- Location: Melbourne Australia
Re: Return True if there are any common letters between two strings
I didn't do any speed tests but this seems to work without a loop
Credit: I found the method on this page https://analystcave.com/vba-like-operator/
Code: Select all
Sub TestSubfind()
If "efghijklmnopqrstuvwxyz!!#v" Like "*[ABCDEFGHIJKLMNOPabcd]*" Then
Debug.Print "Match!"
End If
End Sub
Andrew Lockton
Melbourne Australia
Melbourne Australia
-
- PlatinumLounger
- Posts: 4931
- Joined: 31 Aug 2016, 09:02
Re: Return True if there are any common letters between two strings
Thanks a lot Guessed for sharing and for the new trick.
-
- 2StarLounger
- Posts: 102
- Joined: 04 Feb 2010, 22:44
- Location: Melbourne Australia
Re: Return True if there are any common letters between two strings
You will need to be careful on the allowed search characters since using the Like command means that characters such as * and [ and ] will be problematic to search for.
Andrew Lockton
Melbourne Australia
Melbourne Australia
-
- PlatinumLounger
- Posts: 4931
- Joined: 31 Aug 2016, 09:02
Re: Return True if there are any common letters between two strings
Is there a way to avoid those characters and treat them as literal characters, not special characters?
-
- Administrator
- Posts: 78558
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Return True if there are any common letters between two strings
To use [, ], ? or * in the string on the right hand side of Like, enclose them in [ ].
So [[] looks for the literal character [, []] looks for the literal character ], [?] for ? and [*] for *.
So [[] looks for the literal character [, []] looks for the literal character ], [?] for ? and [*] for *.
Best wishes,
Hans
Hans
-
- BronzeLounger
- Posts: 1499
- Joined: 28 Feb 2015, 13:11
- Location: Hof, Bayern, Germany
Re: Return True if there are any common letters between two strings
Hi Hans,
I am not quite sure what you are saying. - Assuming that the “string on the right hand side of Like” would be one of the strings, ( like your s1 or s2 ) , then you would just use the Wildcard things as normal characters.... I think ... maybe...
To better explain what I mean. .. Lines 41 and 42 seem to be the way to do it. But I interpreted what you said to be like line 31 and 32, which does not seem to work. I might likely have misunderstood what you said
In short: it seems that in the solution offered by Guessed, you don’t need to make any extra allowance for using the Wildcard characters as literal
Code: Select all
Sub GuessedAndWildcards() ' https://eileenslounge.com/viewtopic.php?p=282392#p282392
Rem Guessed Offering applied to the Original Test Example
11 If "cfgh!!#v" Like "*[abcd]*" Then Debug.Print True ' True
12 If "abcd!!#v" Like "*[cfgh!!#v]*" Then Debug.Print True ' True
21 If "efgh!!#v" Like "*[abcd]*" Then Debug.Print True ' ____ not true
22 If "abcd" Like "*[efgh!!#v]*" Then Debug.Print True ' ____ not true
Rem For using as literal characters the wildcards use by the VBA Like operator to replace certain strings or characters
31 If "efg*h!!#v" Like "*[ab[*]cd]*" Then Debug.Print True ' ____ not true ( doesn't work )
32 If "ab*cd" Like "*[efg[*]h!!#v]*" Then Debug.Print True ' ____ not true ( doesn't work)
41 If "efg*h!!#v" Like "*[ab*cd]*" Then Debug.Print True ' True ( works)
42 If "ab*cd" Like "*[efg*h!!#v]*" Then Debug.Print True ' True ( works)
End Sub
If I understand correctly, Guessed’s offering is pseudo like
If s1 Like "*[" & s2 & "]*" Then Let Geussed = True
If I understand correctly what’s going on there, the left hand side gets attempted to match to any character combination that includes any single character inside the [ ] - That is exactly what we want, and solves the problem very nicely.
Further, my experiments suggest that within the [ ] on the Right Hand Side of Like you can have anything including all the things used as wildscards. – That sort of ties up with generally what you said
Last edited by Doc.AElstein on 09 Apr 2021, 10:58, edited 6 times in total.
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also
You can find me at DocAElstein also
-
- BronzeLounger
- Posts: 1499
- Joined: 28 Feb 2015, 13:11
- Location: Hof, Bayern, Germany
Re: Return True if there are any common letters between two strings
Hello Guessed
That Like operator has been on my list of things to get clued up on for some time: it looks like a very useful thing to have in a VBA programmers Tool box. Looking at that link you gave, it does not seem so difficult to understand as other “Wild things, RegEx and Co.”, which always give me a migrate trying to understand. ( That analystcave place looks like generally a good place for some good VBA string function blogs )
I added your like version in a function form for comparison out of interests.
I haven’t tested thoroughly, but an initial look suggests that your offering, when applied to similar test data to that we have considered so far, its similar to the best results, in terms of speed, we have so far.
( Macro in next post, it wont fit in here... )
Alan
That Like operator has been on my list of things to get clued up on for some time: it looks like a very useful thing to have in a VBA programmers Tool box. Looking at that link you gave, it does not seem so difficult to understand as other “Wild things, RegEx and Co.”, which always give me a migrate trying to understand. ( That analystcave place looks like generally a good place for some good VBA string function blogs )
I added your like version in a function form for comparison out of interests.
I haven’t tested thoroughly, but an initial look suggests that your offering, when applied to similar test data to that we have considered so far, its similar to the best results, in terms of speed, we have so far.
( Macro in next post, it wont fit in here... )
Alan
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also
You can find me at DocAElstein also
-
- BronzeLounger
- Posts: 1499
- Joined: 28 Feb 2015, 13:11
- Location: Hof, Bayern, Germany
Re: Return True if there are any common letters between two strings
Test coding for last post
Code: Select all
' https://eileenslounge.com/viewtopic.php?f=30&t=36382
Option Explicit
Private Declare Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
Private Const sCPURegKey = "HARDWARE\DESCRIPTION\System\CentralProcessor\0"
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Function MicroTimer() As Double
Dim cyTicks1 As Currency: Static cyFrequency As Currency
Let MicroTimer = 0
If cyFrequency = 0 Then getFrequency cyFrequency ' get ticks/sec
Call getTickCount(cyTicks1) ' get ticks
If cyFrequency Then Let MicroTimer = cyTicks1 / cyFrequency ' calc seconds
End Function
Sub Tests()
Debug.Print "ComonEileen (Alan)" ' ' For if no duplicates in either word
Dim TimIt As Double
Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "cfgh!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "efgh!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Debug.Print
Debug.Print "ComonEileen2 (Alan)" ' For if there might be duplicates in words
Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "cfgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "efgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Debug.Print
Debug.Print "CommonH ( Hans )"
Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "cfgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "efgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Debug.Print
Debug.Print "Like Geussed"
Let TimIt = MicroTimer
Debug.Print Geussed("abcd", "cfgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print Geussed("abcd", "efgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Debug.Print
Debug.Print "Like Geussed2"
Let TimIt = MicroTimer
Debug.Print Geussed2("abcd", "cfgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print Geussed2("abcd", "efgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
End Sub
' For if no duplicates in either word
Sub Test1()
Debug.Print "ComonEileen (Alan)"
Dim TimIt As Double
Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "cfgh!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print ComonEileen("abcd", "efgh!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
End Sub
Function ComonEileen(s1 As String, s2 As String) As Boolean
Dim Dik As Scripting.Dictionary
Set Dik = New Scripting.Dictionary
Dim Cnt As Long
For Cnt = 1 To Len(s1 & s2)
Let Dik(Mid(s1 & s2, Cnt, 1)) = "Anything"
Next Cnt
If Len(Join(Dik.Keys(), "")) <> Len(s1 & s2) Then Let ComonEileen = True
End Function
' For if there might be duplicates in words
Sub Test2()
Debug.Print
Debug.Print "ComonEileen2 (Alan)"
Dim TimIt As Double
Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "cfgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print ComonEileen2("abcd", "efgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
End Sub
Function ComonEileen2(s1 As String, s2 As String) As Boolean
Dim Dik As Scripting.Dictionary, Dik1 As Scripting.Dictionary, Dik2 As Scripting.Dictionary
Set Dik = New Scripting.Dictionary: Set Dik1 = New Scripting.Dictionary: Set Dik2 = New Scripting.Dictionary
Dim Cnt As Long
For Cnt = 1 To Len(s1)
Let Dik1(Mid(s1, Cnt, 1)) = "Anything"
Next Cnt
Let s1 = Join(Dik1.Keys(), "")
For Cnt = 1 To Len(s2)
Let Dik2(Mid(s2, Cnt, 1)) = "Anything"
Next Cnt
Let s2 = Join(Dik2.Keys(), "")
For Cnt = 1 To Len(s1 & s2)
Let Dik(Mid(s1 & s2, Cnt, 1)) = "Anything"
Next Cnt
If Len(Join(Dik.Keys(), "")) <> Len(s1 & s2) Then Let ComonEileen2 = True
End Function
Sub TestHans()
Debug.Print
Debug.Print "CommonH ( Hans )"
Dim TimIt As Double
Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "cfgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
Let TimIt = MicroTimer
Debug.Print CommonH("abcd", "efgh!!#v") & " " & Format(MicroTimer - TimIt, "0.000000000")
End Sub
Function CommonH(s1 As String, s2 As String) As Boolean
Dim n1 As Long, n2 As Long, i As Long
n1 = Len(s1)
n2 = Len(s2)
If n1 < n2 Then
For i = 1 To n1
If InStr(s2, Mid(s1, i, 1)) Then
CommonH = True
Exit Function
End If
Next i
Else
For i = 1 To n2
If InStr(s1, Mid(s2, i, 1)) Then
CommonH = True
Exit Function
End If
Next i
End If
End Function
'
Function Geussed(s1 As String, s2 As String) As Boolean
If s1 Like "*[" & s2 & "]*" Then Let Geussed = True
End Function
Function Geussed2(s1 As String, s2 As String) As Boolean
If s2 Like "*[" & s1 & "]*" Then Let Geussed2 = True
End Function
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also
You can find me at DocAElstein also
-
- BronzeLounger
- Posts: 1499
- Joined: 28 Feb 2015, 13:11
- Location: Hof, Bayern, Germany
Re: Return True if there are any common letters between two strings
Just to clarify how I see the offering from Guessed applied to the original test data we used...
If I understand correctly, Guessed’s offering is pseudo like
If s1 Like "*[" & s2 & "]*" Then Let Geussed = True
In the above snippet code line, the strings in s1 or s2 can have things like
[ # ] * ?
in them with no modification
If I understand correctly what’s going on there, the left hand side gets attempted to match to any character combination that includes any single character inside the [ ] - That is exactly what we want, and solves the problem very nicely.
Further, my experiments suggest that within the [ ] on the Right Hand Side of Like you can have anything including all the things used as wildscards. – That sort of ties up with generally with what Hans said, but it means, I think, in this case, that we need to make no adjustment to the original text to allow the Geussed offering to work - we don't need to include our wildcard characters which we want to use as literals in enclosing [ ] on the RHS, because we are already in a pair of [ ] on the RHS
Code: Select all
' https://eileenslounge.com/viewtopic.php?p=282383#p282383
Sub TestGuessed()
If "cfgh!!#v" Like "*[abcd]*" Then ' True
Debug.Print "Match!"
End If
If "efgh!!#v" Like "*[abcd]*" Then ' False
Debug.Print "Match!"
End If
End Sub
Sub TestGuessed2()
If "abcd" Like "*[cfgh!!#v]*" Then ' True
Debug.Print "Match!"
End If
If "abcd" Like "*[efgh!!#v]*" Then ' False
Debug.Print "Match!"
End If
End Sub
If I understand correctly, Guessed’s offering is pseudo like
If s1 Like "*[" & s2 & "]*" Then Let Geussed = True
In the above snippet code line, the strings in s1 or s2 can have things like
[ # ] * ?
in them with no modification
If I understand correctly what’s going on there, the left hand side gets attempted to match to any character combination that includes any single character inside the [ ] - That is exactly what we want, and solves the problem very nicely.
Further, my experiments suggest that within the [ ] on the Right Hand Side of Like you can have anything including all the things used as wildscards. – That sort of ties up with generally with what Hans said, but it means, I think, in this case, that we need to make no adjustment to the original text to allow the Geussed offering to work - we don't need to include our wildcard characters which we want to use as literals in enclosing [ ] on the RHS, because we are already in a pair of [ ] on the RHS
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also
You can find me at DocAElstein also