Teilstring aus String entfernen | Herbers Excel-Forum

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Teilstring aus String entfernen | Herbers Excel-Forum

Teilstring aus String entfernen von skaddy vom 27.02.2010 21:21:32

vor erstem und nach letztem ; extrahieren - von WF am 27.02.2010 22:01:29
- AW: vor erstem und nach letztem ; extrahieren - von skaddy am 27.02.2010 23:00:06
  - AW: vor erstem und nach letztem ; extrahieren - von Peter am 27.02.2010 23:51:47
    - Nein das hilft ihm nicht weiter... - von Josef B am 28.02.2010 12:58:57
      - ...Unter OOcalc fkt sogar beide NICHT! ;-) orT - von Luc:-? am 28.02.2010 15:19:08
        
        OOcalc und VERWEIS - von Josef B am 28.02.2010 16:04:51
        
        Ja, das fkt auch unter OOcalc,... - von Luc:-? am 28.02.2010 17:20:01
- In VBA kann das so gehen,... - von Luc:-? am 28.02.2010 05:18:50
  - So, die einzigen Fehler, die ich bisher... - von Luc:-? am 28.02.2010 17:46:19
    - Und das war hoffentl der letzte... - von Luc:-? am 28.02.2010 21:30:49
      - Jetzt doch noch 'ne andere Formel,... - von Luc:-? am 28.02.2010 22:47:28
AW: Teilstring aus String entfernen - von Reinhard am 28.02.2010 09:10:07

Betrifft: Teilstring aus String entfernen von: skaddy
Geschrieben am: 27.02.2010 21:21:32

Hallo zusammen

Folgendes Problem: Ich habe einen String in einer Excel Zelle, den ich auf ein weiteres Tabellenblat kopieren möchte, jedoch wenn in dem String ein "$" als erstes Zeichen steht folgt an unbestimmerter Stelle ein ";" dann wieder Text, und dann wieder ein ";" und dann wieder Text. Die verschiedenen Texte in den Zellen sind unterschiedlich lang. Hier ein Beispiel: "$Hallo ;Das hier muss ich löschen; Welt"
Meine Frage nun: Wie kann ich das erste Zeichen auf "$" prüfen und dann weiter den Teilstring zwischen ; und ; herauslöschen? So Schleifen und kopieren in VBA bekomm ich hin, nur das herausschneiden des Teilstrings weiss ich nicht wie ich das angehen könnte, im Archiv habe ich so nichts gefunden...
Bin um jeden Tipp oder Codeschnipsel dankbar...

Besten Dank für eure Hilfe
skaddy

Betrifft: vor erstem und nach letztem ; extrahieren von: WF
Geschrieben am: 27.02.2010 22:01:29

Hi skaddy,

=LINKS(A1;FINDEN(";";A1)-1)&RECHTS(A1;LÄNGE(A1)-VERWEIS(999;FINDEN(";";A1;ZEILE(A:A)))+1)

Ich schätze mal, das Leerzeichen vor dem ersten ; (statt danach) ist ein Tippfehler.

Salut WF

Betrifft: AW: vor erstem und nach letztem ; extrahieren von: skaddy
Geschrieben am: 27.02.2010 23:00:06

Hallo WF
Danke für deine Hilfe.
Da ich die Daten direkt weiterverarbeiten muss in einem weiterem excel file und ich für diesen kopiervorgang schon ein Makro habe muss ich das direkt in VBA lösen und kann leider die Formel nicht benutzen.
Besten Dank trozdem
Gruss skaddy

Betrifft: AW: vor erstem und nach letztem ; extrahieren von: Peter
Geschrieben am: 27.02.2010 23:51:47

Hallo skaddy

das ist die Formel von WF als Anwendung in VBA...

Sub Teilstrings()
Cells(1, 10).Formula = "=LEFT(A1,FIND("";"",A1)-1)&RIGHT(A1,LEN(A1)-LOOKUP(999,FIND("";"",A1, _
ROW(A:A)))+1)"
Cells(1, 10).Copy
Cells(1, 10).PasteSpecial Paste:=xlPasteValues
End Sub

Vieleicht hilft Dir das weiter...

Gruß

Peter

Betrifft: Nein das hilft ihm nicht weiter... von: Josef B
Geschrieben am: 28.02.2010 12:58:57

Hallo Peter

..den die Formel von WF bringt nicht das richtige Ergebniss.
Hier die Formel, die du nach VBA umschreiben kannst.

=TEIL(A1;2;FINDEN(";";A1)-3)&RECHTS(A1;LÄNGE(A1)-VERWEIS(999;FINDEN(";";A1;ZEILE(A:A))))

Gruss Sepp

Betrifft: ...Unter OOcalc fkt sogar beide NICHT! ;-) orT von: Luc:-?
Geschrieben am: 28.02.2010 15:19:08

Gruß+schöSonAb, Luc :-?

Betrifft: OOcalc und VERWEIS von: Josef B
Geschrieben am: 28.02.2010 16:04:51

Hallo Luc

VERWEIS scheint in OOcalc anders zu funktionieren, und liefert in diesem Beispiel einen Fehler.
Aber es geht in diesem Fall auch locker ohne Verweis, z.B. so:
=TEIL(A1;2;FINDEN(";";A1)-3)&TEIL(A1;FINDEN(";";A1;FINDEN(";";A1)+1)+1;99)

Gruss Sepp

Betrifft: Ja, das fkt auch unter OOcalc,... von: Luc:-?
Geschrieben am: 28.02.2010 17:20:01

…Sepp,
aber die Fmln sind doch sehr genau auf die richtige Position von ";" ausgerichtet, während ich jetzt glaube, dass eigentlich der Zwischenraum gemeint war. Der Fragesteller hatte nämlich irgendwo im Doppel-Thread was von doppelten Leerzeichen geschrieben, die noch zu 1em wdn müssten…
Gruß + schöSonAb, Luc :-?

Betrifft: In VBA kann das so gehen,... von: Luc:-?
Geschrieben am: 28.02.2010 05:18:50

…Skaddy…

Rem Autor: LSr\CyWorXxl - CDate:20100227/28 - 1Pub:20100228 Herber
Function PickOn(ByVal Bezug, Optional ByVal Wahl = 1, Optional ByVal _
                TrennZ As String = " ", Optional ByVal KritBezug As Boolean = True)
    Dim dl As Boolean, i As Long, ug As Long, dt As String, _
        ac As Range, bt, bezFeld, ergW(), kritFeld, w As Variant
    On Error Resume Next
    With Application
        dt = .International(xlDecimalSeparator)
        If IsError(.Caller.Address) Then _
            Set ac = ActiveWindow.RangeSelection Else Set ac = .Caller
    End With
    If Not IsArray(Wahl) Then
        dl = (Left(Wahl, 1) = "-")
        If dl Then Wahl = Mid(Wahl, 2)
        If Not IsNumeric(Wahl) And Instr(Wahl, dt) = 0 Then
            i = 1 - CInt(dl)
            While i <= Len(Wahl) And IsNumeric(Mid(Wahl, i, 1)): i = i + 1: Wend
            dt = Mid(Wahl, i, 1): i = 0
            If dt <> " " Then Wahl = Replace(Wahl, " ", "")
            Wahl = Split(Wahl, dt)
        ElseIf CBool(Instr(Wahl, dt)) Then
            Wahl = Split(Wahl, dt)
        End If
    Else
        With WorksheetFunction
            If TypeName(Wahl) = "Range" Then Wahl = .Transpose(Wahl)
            If IsError(LBound(Wahl, 2)) Then Else Wahl = .Transpose(Wahl)
            If IsError(LBound(Wahl, 2)) Then Else PickOn = CVError(xlErrRef): GoTo ex
        End With
        dl = (Wahl(LBound(Wahl)) < 0)
    End If
    If IsArray(Bezug) Then
        With WorksheetFunction
            If TypeName(Bezug) = "Range" Then
                bezFeld = .Transpose(Bezug)
            Else: bezFeld = Bezug
            End If
            If IsError(LBound(bezFeld, 2)) Then Else bezFeld = .Transpose(bezFeld)
            If IsError(LBound(bezFeld, 2)) Then Else PickOn = CVError(xlErrRef): GoTo ex
            If IsArray(KritBezug) Then
                If TypeName(KritBezug) = "Range" Then kritFeld = .Transpose(KritBezug)
                If IsError(LBound(kritFeld, 2)) Then Else kritFeld = .Transpose(kritFeld)
                If IsError(LBound(kritFeld, 2)) Then Else PickOn = CVError(xlErrRef): GoTo ex
            Else: kritFeld = KritBezug
            End If
        End With
        If UBound(bezFeld) <> UBound(kritFeld) Then _
            PickOn = CVErr(xlErrRef): GoTo ex
        ug = LBound(bezFeld): ReDim ergW(UBound(bezFeld) - ug)
        For Each Bezug In bezFeld
            If IsArray(kritFeld) Then KritBezug = kritFeld(i + ug)
            GoSub ew: ergW(i) = PickOn: i = i + 1
        Next Bezug
        If ac.Columns.Count = 1 Then
            PickOn = WorksheetFunction.Transpose(ergW)
        Else: PickOn = ergW
        End If
        GoTo ex
    ElseIf IsArray(KritBezug) Then
        PickOn = CVErr(xlErrRef): GoTo ex
    End If
ew: If CBool(KritBezug) Then
        If dl Then PickOn = Bezug Else PickOn = ""
        bt = Split(Bezug, TrennZ)
        If IsArray(Wahl) Then
            For Each w In Wahl
                If Abs(w) > 0 Then
                    If Abs(w) - 1 > UBound(bt) Then Exit For
                    If dl Then
                        PickOn = Replace(Replace(PickOn, bt(Abs(w) - 1), "", 1, 1), _
                                 String(2, TrennZ), TrennZ)
                    Else: PickOn = PickOn & TrennZ & bt(Abs(w) - 1)
                    End If
                End If
            Next w
            If Not dl Then PickOn = Mid(PickOn, Len(TrennZ) + 1)
        ElseIf Abs(Wahl) - 1 > UBound(bt) Or CLng(Wahl) = 0 Then
            PickOn = Bezug
        ElseIf dl Then
            PickOn = Replace(Replace(PickOn, bt(Abs(Wahl) - 1), "", 1, 1), _
                     String(2, TrennZ), TrennZ)
        Else: PickOn = bt(Abs(w) - 1)
        End If
    Else: PickOn = Bezug
    End If
    If Not IsEmpty(bezFeld) Then Return
ex: Set ac = Nothing
End Function

Diese Funktion ist eine sog udF und kann im TabBlatt eingesetzt wdn. Sie verlangt mindestens 1 und maximal 4 Argumente…
Arg1: erforderlich; der Bezug auf eine Zelle bzw einen Zellbereich (als Matrixformel) oder ein Datenfeld als Ergebnis eines Ausdrucks.
Arg2: optional; der Teil, der aus einer Zelle bzw einem Element von Arg1 zurückgegeben oder gelöscht (<0) wdn soll; das Argument kann auch ein Zellbereich oder ein Datenfeld sein, das ganze Zahlen enthält. Alternativ hierzu können die auszuwählenden Textteile auch aufgezählt wdn. Das Aufzählungszeichen wird dann automatisch ermittelt. Ein Minus als Löschsymbol darf nur als 1.Zeichen stehen bzw hat nur beim ersten Element eines Datenfeldes Wirkung. Es ist nur entweder Löschen oder Sammeln möglich, nicht beides! Wenn das Argument nicht angegeben wird, wird 1 angenommen. Bei Angabe von 0 bleibt Arg1 unverändert.
Arg3: optional; Zeichen bzw Zeichenkombination, an der der Text lt Arg1 getrennt wdn soll. Bei Nichtangabe wird 1 Leerzeichen angenommen.
Arg4: optional; fehlendes Argument wird als WAHR angenommen; das Argument muss mit Arg1 harmonieren, d.h., ist Arg1 ein Bereich bzw Datenfeld, darf Arg4 entweder nur ein Einzelwert oder ebenfalls ein Bereich/Feld gleicher Elementezahl sein. Anderenfalls darf Arg4 auch nur ein Einzelwert sein.
Sämtliche als Argumente übergebenen Datenfelder und Zellbereiche dürfen nur Vektoren, keine Matrizen sein!
Um die Funktion möglichst universell zu halten, sind hier (in Arg4) die speziellen Bedingg der AfgStellung nicht eingeflossen, d.h., diese müssen extern ausgewertet wdn. Wie, zeigt das anschließende Anwendungsbsp…
=PickOn(A1;-2;";";LINKS(A1)="$")
Die udF sollte auch bei Aufruf durch eine Subroutine fktionieren.
Ich kann nur hoffen, dass sich kein Fehler eingeschlichen hat, denn ich habe das direkt ins Forumsformular geschrieben und nicht getestet…
Gruß+schöSo, Luc :-?

Betrifft: So, die einzigen Fehler, die ich bisher... von: Luc:-?
Geschrieben am: 28.02.2010 17:46:19

…feststellen konnte, Folks,
sind folgende…
- im Kopf der Fkt entfällt As Boolean nach KritBezug — hatte ich überflüssigerweise nachträglich hinzugefügt;
- statt CVError muss es generell CVErr heißen — passiert mir leider mitunter wg der Analogie zu IsError.
Dann noch ein Hinweis zu Arg2 — das ist von evtl Feldern in Arg1/4 unabhängig und gilt, auch als Feld, stets für alle Arg1-Elemente in einem Arg1-Feld. Deshalb hier in einer Matrixfml möglichst keine matrixabhängigen Fktt wie ZEILE oder SPALTE verwenden! Ansonsten können natürlich auch Matrixkonstanten eingesetzt wdn.
…und zu Arg4 — wenn hier auf einen Bereich oder ein Datenfeld bezug genommen wird, ist zu beachten, dass leere Zellen/Elemente als FALSCH und gefüllte als WAHR interpretiert wdn. Es sollte also schon was drinstehen und wenn es ggf nur WAHR ist.
Da es Skaddy in seinem Bsp wohl doch eher um die Leerzeichen als um die Semikolons geht, liefert die auf der vorlgd udFkt aufbauende Fml nur in flgder Form das gewünschte Ergebnis…
=PickOn(A1;-2;;LINKS(A1)="$")
Wenn, wie es WF vorschlägt, das Leerzeichen immer dem Semikolon folgt oder das Leerzeichen ganz fehlt, muss anders vorgegangen wdn. Die udFkt ersetzt nämlich immer den per negativem Arg2 angegebenen Textteil lt Folge-Trennzeichen(Arg3)-Zählung durch ein Trennzeichen lt Arg3. Auch bei positivem Arg2 wird Arg3 als Trenner zwischen den Textteilen verwendet. Wenn diese anschließend ganz entfallen sollen, müssen sie mit umschließendem WECHSELN entfernt wdn.
Gruß Luc :-?

Betrifft: Und das war hoffentl der letzte... von: Luc:-?
Geschrieben am: 28.02.2010 21:30:49

…Fehler:
Beim vorletzten Else: muss es statt Abs(w) Abs(Wahl) heißen.
Luc :-?

Betrifft: Jetzt doch noch 'ne andere Formel,... von: Luc:-?
Geschrieben am: 28.02.2010 22:47:28

…damit das für Skaddy's Bsp auch wirklich fktioniert…
=WECHSELN(PickOn(A1;-2;";";LINKS(A1)="$");" ; ";" ") oder
=WECHSELN(PickOn(A1;1,3;";";LINKS(A1)="$");" ; ";" ")
Diese udF ist so flexibel, dass ziemlich viele Aufgabenvarianten mit ihr im Verbund mit StddFktt gelöst wdn können.
In einer Subroutine könnte man das etwa so verwenden…
Ergebnis = Replace(PickOn(Cells(1, 1), -2, ";", Left(Cells(1, 1), 1) = "$"), " ; ", " ") oder
Ergebnis = Replace(PickOn(Cells(1, 1), 1,3, ";", Left(Cells(1, 1), 1) = "$"), " ; ", " ")
Gruß Luc :-?

Betrifft: AW: Teilstring aus String entfernen von: Reinhard
Geschrieben am: 28.02.2010 09:10:07

Hallo Skaddy,

Function Trenn(Zelle As Range) As String
Dim T As String
Trenn = Zelle.Value
If Left(Trenn, 1) = "$" Then
   T = Mid(Zelle.Value, 2)
   Trenn = Left(T, InStr(T, ";") - 1)
   T = Mid(T, Len(Trenn) + 2)
   Trenn = Application.Trim((Trenn & Mid(T, InStr(T, ";") + 1)))
End If
End Function

Gruß
Reinhard