AW: ja, ist offen ...
20.11.2023 15:29:34
neopa C
Hallo Ralf,
... allerdings funktion der Code bei mir nicht als Add-Ins sondern nur innerhalb einer XLSX-Datei (liegt wohl daran, dass meine XL-Versionen Home-Versionen sind)
Hier der Code:
Public Function TEXTVOR(ByVal Text As Variant, _
ByVal Trenner As String, _
Optional ByVal Element As Variant = 1, _
Optional ByVal match_mode As Boolean = 0, _
Optional ByVal match_end As Boolean = 0, _
Optional ByVal if_not_found) As Variant
Dim zStr As String
Dim erg As Variant
Dim i As Long
On Error GoTo Fehler
If TypeName(Text) = "Range" Then
If Text.Cells.Count > 1 Then TEXTVOR = CVErr(xlErrValue): Exit Function
zStr = Text.Text
Else
zStr = Text
End If
If InStr(1, zStr, Trenner) = 0 And Not match_end Then
TEXTVOR = CVErr(xlErrNA): Exit Function
ElseIf InStr(1, zStr, Trenner) = 0 And match_end Then
TEXTVOR = zStr: Exit Function
End If
If Not match_mode Then
erg = Split(mid(zStr, 1, WorksheetFunction.Find(Trenner, zStr, 1)), Trenner, , vbBinaryCompare)
i = GetDim(erg): If (i > -1 And i > 1) Then Err.Raise 1
End If
If Not IsMissing(Element) Then
If Trenner = "" And Element = 1 Then TEXTVOR = "": Exit Function
If Trenner = "" And Element 0 Then TEXTVOR = zStr: Exit Function
If match_mode Then
erg = Split(zStr, Trenner, , vbTextCompare)
Else
erg = Split(zStr, Trenner, , vbBinaryCompare)
End If
If Element 0 Then Element = UBound(erg) + Element + 1
Element = Element - 1
erg = erg(Element)
Else
With WorksheetFunction
If match_mode Then
erg = .Search(Trenner, zStr, 1)
Else
erg = .Find(Trenner, zStr, 1)
End If
erg = mid(zStr, 1, erg)
End With
End If
TEXTVOR = erg
Exit Function
Fehler:
If Not IsMissing(if_not_found) Then TEXTVOR = if_not_found Else TEXTVOR = CVErr(xlErrNA)
End Function
Gruß Werner
.. , - ...