Thema Datum  Von Nutzer Rating
Antwort
18.09.2023 18:46:02 Berni
Solved
19.09.2023 06:54:57 ralf_b
NotSolved
19.09.2023 07:53:30 Mase
NotSolved
Blau "Select Case" mit 2 Bedingungen
19.09.2023 16:45:37 Gast38129
NotSolved
19.09.2023 22:16:56 Gast53982
NotSolved
20.09.2023 06:31:38 Mase
NotSolved
20.09.2023 10:25:04 Gast69270
NotSolved

Ansicht des Beitrags:
Von:
Gast38129
Datum:
19.09.2023 16:45:37
Views:
311
Rating: Antwort:
  Ja
Thema:
"Select Case" mit 2 Bedingungen

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

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
18.09.2023 18:46:02 Berni
Solved
19.09.2023 06:54:57 ralf_b
NotSolved
19.09.2023 07:53:30 Mase
NotSolved
Blau "Select Case" mit 2 Bedingungen
19.09.2023 16:45:37 Gast38129
NotSolved
19.09.2023 22:16:56 Gast53982
NotSolved
20.09.2023 06:31:38 Mase
NotSolved
20.09.2023 10:25:04 Gast69270
NotSolved