Option Explicit
Function SameStrings(R1 As String, R2 As String, _
Optional Include As Boolean = False, _
Optional Delimiteurs As String = " ,;:()'") _
As Boolean
' ==========================================================================================
' Tous les mots de R1 doivent se retrouver dans R2
' si include est false le nombre de mots dans R1 et R2 doivent être identiques
' sinon le nombre de mots de R1 peut être moins grand que celui de R2 (R1 inclus dans R2)
' Si des délimiteurs sont précisés , ils remplacent ceux par défaut
' ==========================================================================================
Dim P1, P2
Dim N As Integer, I As Integer, J As Integer
Delimiteurs = Delimiteurs & vbCrLf
For I = 1 To Len(Delimiteurs)
R1 = Replace(R1, Mid(Delimiteurs, I, 1), " ")
R2 = Replace(R2, Mid(Delimiteurs, I, 1), " ")
Next
P1 = Split(Application.Trim(R1))
P2 = Split(Application.Trim(R2))
N = -1
Select Case True
Case UBound(P1) < 0
Case UBound(P2) < 0
Case (UBound(P1) < UBound(P2)) And Not Include
Case (UBound(P1) > UBound(P2)) And Include
Case Else
For I = 0 To UBound(P1)
For J = 0 To UBound(P2)
If StrComp(P1(I), P2(J), vbTextCompare) = 0 Then
N = N + 1
Exit For
End If
Next
Next
SameStrings = N = UBound(P1)
End Select
End Function