Da würde ich bereits überlegen, die Logik dafür in eine Klasse auszulagern.
'Klassenmodul: Person
Option Explicit
Private Const E_CANNOT_PARSE As Long = &HA
Private Const E_INVALID As Long = &HC
Private m_strFirstName As String
Private m_strSecondName As String
Private m_strLastName As String
Public Property Get FullName() As String
FullName = Me.FirstName
If Me.HasSecondName Then FullName = FullName & " " & Me.SecondName
FullName = FullName & " " & Me.LastName
End Property
Public Property Let FirstName(RHS As String)
m_strFirstName = RHS
End Property
Public Property Get FirstName() As String
FirstName = m_strFirstName
End Property
Public Property Let SecondName(RHS As String)
m_strSecondName = RHS
End Property
Public Property Get SecondName() As String
SecondName = m_strSecondName
End Property
Public Property Let LastName(RHS As String)
m_strLastName = RHS
End Property
Public Property Get LastName() As String
LastName = m_strLastName
End Property
Public Property Get HasSecondName() As Boolean
HasSecondName = Not (Me.SecondName = vbNullString)
End Property
Public Sub Parse(Expression As Variant)
Dim vntParts As Variant
vntParts = Expression
'doppelte Leerzeichen entfernen
Do While InStr(vntParts, " ")
vntParts = Replace$(vntParts, " ", " ")
Loop
'auftrennen (mit Leerzeichen als Trennzeichen)
vntParts = Split(Trim$(vntParts), " ")
Select Case UBound(vntParts)
Case 1
Me.FirstName = vntParts(0)
Me.SecondName = vbNullString
Me.LastName = vntParts(1)
Case 2
Me.FirstName = vntParts(0)
Me.SecondName = vntParts(1)
Me.LastName = vntParts(2)
Case Else
Call Err.Raise(vbObjectError + E_CANNOT_PARSE, "Person", "Cannot parse expression: '" & Expression & "'")
End Select
If Len(Me.FirstName) = 0 Or Len(Me.LastName) = 0 Or (Me.HasSecondName And Len(Me.SecondName) = 0) Then
Call Err.Raise(vbObjectError + E_INVALID, "Person", "The person's name is invalid.")
End If
End Sub
Public Function Compare( _
Other As Person, _
Optional IncludeSecondName As Boolean = False, _
Optional CompareMethod As VbCompareMethod = VbCompareMethod.vbTextCompare _
) As Integer
Compare = StrComp(Me.LastName, Other.LastName, CompareMethod)
If Compare <> 0 Then
Exit Function
End If
Compare = StrComp(Me.FirstName, Other.FirstName, CompareMethod)
If Compare <> 0 Then
Exit Function
End If
If IncludeSecondName = False Then
Exit Function
End If
Compare = (StrComp(Me.SecondName, Other.SecondName, CompareMethod) = 0)
End Function
Public Function Equals(Other As Object) As Boolean
If Not TypeOf Other Is Person Then
Exit Function
End If
Equals = (Me.Compare(Other) = 0)
End Function
Auf diese Weise wäre es später noch leicht erweiterbar - zum Beispiel für verschiedene Strategien für's Parsen, Vergleichen, Validieren...
Und verwendet wird es dann zum Beispiel so:
'Modul: Module1
Option Explicit
Sub TestExample()
'Beispieldaten, welche normalerweise vom Tabellenblatt kommen
Dim vntNames As Variant
vntNames = Array( _
"Paula Virginia Claro", _
"Castelli Cavadini Claudia", _
"D'Agostini Susi", _
"Castelli Claudia", _
" D'Agostini Claudia ")
'diese Person soll in den Beispieldaten gefunden werden
Dim objPersonRef As Person
Set objPersonRef = New Person
Call objPersonRef.Parse("Castelli Claudia")
Dim objPerson As New Person
Set objPerson = New Person
Dim vntName As Variant
For Each vntName In vntNames
Call objPerson.Parse(vntName)
Debug.Print "»"; objPersonRef.FullName; "« EQUALS »"; vntName; "«", "=> "; IIf(objPersonRef.Equals(objPerson), "YEP", "NOP")
Next
End Sub
übrigens, die Ausgabe:
»Castelli Claudia« EQUALS »Paula Virginia Claro« => NOP
»Castelli Claudia« EQUALS »Castelli Cavadini Claudia« => YEP
»Castelli Claudia« EQUALS »D'Agostini Susi« => NOP
»Castelli Claudia« EQUALS »Castelli Claudia« => YEP
»Castelli Claudia« EQUALS » D'Agostini Claudia « => NOP
|