Microsoft Excel

Herbers Excel/VBA-Archiv

String splitten | Herbers Excel-Forum


Betrifft: String splitten von: Walter
Geschrieben am: 20.01.2012 12:38:40

Hallo,

ich habe folgendes Problem:

eine Kombination von Zahlen bestehend aus Kunden-Nr. und Auftrags-Nr.
zwischen den beiden Nummern sind 4 Nullen.
Die Länge der Kunden-Nr. und Auftrags-Nr. ist variabel.

z.B. 4711000013456 - Kd-Nr. 4711, Auftrags-Nr. 13456
471000005678910 - Kd-Nr. 4710, Auftrags-Nr. 5678910

Im 2. Beispiel soll die Letzte Null bei der Kunden-Nr. nicht abgeschnitten werden.

Kann mir jemand hier helfen?

Walter

  

Betrifft: AW: String splitten von: ransi
Geschrieben am: 20.01.2012 13:07:00

HAllo Walter

Kann die Auftragsnummer denn auch eine führende Null enthalten ?

ransi


  

Betrifft: AW: String splitten von: Rudi Maintaire
Geschrieben am: 20.01.2012 13:12:59

Hallo,

 ABC
1   
24711000013456471113456
347100000567891047105678910
4123450000670001234567000

ZelleFormel
B2=LINKS(WECHSELN(A2;"0000";"#");FINDEN("#";WECHSELN(A2;"0000";"#"))-1)& WENN(TEIL(WECHSELN(A2;"0000";"#");FINDEN("#";WECHSELN(A2;"0000";"#"))+1;1)="0";"0";"")
C2=TEIL(A2;LÄNGE(B2)+5;99)


Gruß
Rudi


  

Betrifft: AW: String splitten von: jojo
Geschrieben am: 20.01.2012 13:13:50

https://www.herber.de/bbs/user/78529.xls


  

Betrifft: nicht so kompliziert ! von: WF
Geschrieben am: 20.01.2012 13:19:28

Hi,

=LINKS(A1;4)
und
=TEIL(A1;FINDEN("000";TEIL(A1;5;19))+8;19)

Salut WF


  

Betrifft: AW: nicht so kompliziert ! von: Rudi Maintaire
Geschrieben am: 20.01.2012 13:22:47

Hallo Walter,
Die Länge der Kunden-Nr. und Auftrags-Nr. ist variabel.
KundenNr also nicht immer 4-stellig.
Damit scheitern deine Formeln.

Gruß
Rudi


  

Betrifft: dann seziere mal von: WF
Geschrieben am: 20.01.2012 13:40:11

40000000013456

Hi Rudi,

da kommt bei Dir 4 und 000013456 raus

Salut WF


  

Betrifft: Skalpell von: Rudi Maintaire
Geschrieben am: 20.01.2012 13:56:21

Hallo,
stimmt.
Da kann ich nur hoffen, dass er keine glatten 100er, 1000er, 10000er etc. als Kundennummer hat ;-)

Gruß
Rudi


  

Betrifft: AW: String splitten von: Rudi Maintaire
Geschrieben am: 20.01.2012 14:04:37

Hallo,
dann per Matrixformel.

 ABC
24000000013456400013456
3412350000698744123569874
41000012112
5123000006789001230678900

ZelleFormel
B2{=LINKS(A2;MAX((TEIL(A2;SPALTE($1:$1);4)="0000")*SPALTE($1:$1))-1)}
C2=TEIL(A2;LÄNGE(B2)+5;99)
Achtung, Matrixformel!
Die geschweiften Klammern{} nicht eingeben,
sondern die Zelle mit
Shift + Strg + Enter
verlassen statt Enter alleine.


Gru0
Rudi


  

Betrifft: Das wäre auch ohne MxFml, aber dafür ... von: Luc:-?
Geschrieben am: 21.01.2012 06:05:21

…natürlich länger, gegangen, Rudi …
=LINKS(A2;AUFRUNDEN(LÄNGE(A2)/2;0)-4+LÄNGE(RECHTS(A2;LÄNGE(A2)/2))-LÄNGE(--RECHTS(A2;LÄNGE(A2)/2)))
Natürlich nur unter der Voraussetzung, dass Kunden- und Auftragsnr annähernd gleichlang sind resp ihr Längenverhältnis nicht ungünstiger als bei Bsp2 ist. Allerdings wäre es wohl günstiger, den 2.Teil aufzurunden, hätte die Fml aber etwas verlängert. Alternativ kann auch ohne Runden gearbeitet wdn, aber dann muss bei ungerader Länge 1 zum linken Teil addiert wdn. Leider verkürzt auch der Einbau einer kleinen Merk-UDF, um die Wiederholungen zu vermeiden, die FmlLänge nicht merklich, das wäre erst bei Namensvergabe für diese FmlTeile etwas deutlicher.
Aber deine MxFml scheint ja ggf noch universaler zu sein. Viell probiere ich's spaßeshalber noch mit meinen Split-UDF aus, aber das erfordert dann sicher auch ein paar Klimmzüge in diesem doch ziemlich speziellen Fall.
Eine Ratz-Batz-Lösung mit einer Subroutine (wie unten vorgestellt) ist zwar hier auch sinnvoll, da ja wohl ein endgültiges Ergebnis erzielt wdn soll, aber sobald mit den Ergebnissen weitergerechnet oder in der Tab irgendwie weitergearbeitet wdn soll, ziehe ich Fmln (gern auch m.UDF) vor. Das „Anwerfen” einer Subproz stört nur den Ablauf, wenn es nicht automatisch erfolgt.
Gruß + schöWE, Luc :-?


  

Betrifft: Muss mich korrigieren: Deine Fml fktt nicht, ... von: Luc:-?
Geschrieben am: 22.01.2012 13:08:18

…Rudi,
wenn die Auftragsnr auf 4 Nullen endet, was bei flfd Vergabe ja durchaus mal vorkommen könnte. Unter der Voraussetzung, dass die letzte Null nach der Kundennr nicht schon zur Auftragsnr gehört, dann könnte man wohl alle Lösungsvarianten vergessen, fktt meine längere Fml durchaus. Wahrscheinl kommen ja die unterschiedl Längen beider Nr dadurch zustande, dass sie ohne Vornullen mit 0000-Einschub aneinandergereiht wdn. Dann wäre dieser Einschub auch hinreichend signifikant, denn höchstwahrscheinl wird es weder eine Kunden- noch Auftragsnr 0 geben.
Mit meinen Split-udFktt wird die Fml auch nicht wesentl kürzer, außer viell bei einer, die den Text aber auch erst mal in 2 gleich große Teile teilt.
Aber das Ganze hat mich auf eine Idee gebracht: Wie wäre es denn mal mit einer udFkt, die einen Muster-Vgl realisiert? So etwas hatte ich zwar schon mal vor Jahren geschrieben (steht auch noch im Archiv), habe das Ganze aber noch mal neu und etwas spezieller für solche Zwecke überdacht. Im Ergebnis ist eine UDF entstanden, die prüft, ob ein Text einem Muster entspricht, und, falls verlangt, Anfangs- u/o Endposition des relevanten Textteils liefert. Auf die vorliegende Aufgabe angewendet, könnten so für einen Wert per MatrixFml gleich beide Nr unter Nutzung beider Positionen geliefert wdn. Ansonsten ist bei Nutzung nur einer Position die Rückgabe beider Nr einer ganzen Matrix solcher Werte per MxFml mögl.
Bei bekundetem Interesse würde ich die (recht code-aufwendige) UDF nebst BspFml hier einstellen.
Gruß + schöSo, Luc :-?


  

Betrifft: AW: String splitten von: Peter Feustel
Geschrieben am: 20.01.2012 14:57:45

Hallo Walter,

hier noch eine VBA-Variante:

Public Sub Aufdroeseln()

Dim lZeile  As Long
Dim iPosit  As Integer

   With ThisWorkbook.Worksheets("Tabelle1")
      For lZeile = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
         iPosit = InStrRev(.Range("A" & lZeile).Value, "0000")
         If iPosit > 0 Then
            .Range("D" & lZeile).Value = Left(.Range("A" & lZeile).Value, iPosit - 1)
            .Range("E" & lZeile).Value = Mid(.Range("A" & lZeile).Value, iPosit + 4)
         End If
      Next lZeile
   End With

End Sub

Gruß Peter


  

Betrifft: Abgesehen mal davon, dass hier .Cells(4... von: Luc:-?
Geschrieben am: 22.01.2012 19:27:30

5 bzw 1, lZeile) gereicht hätte, Peter,
hättest du die Aufgabe ganz gut gelöst, wenn die Auftragsnr nie auf 4x0 enden bzw dies enthalten kann. ;-)
Aber für Walter war das Problem wohl doch nicht so wichtig, als dass er uns einer Stellungnahme würdigen würde. :-|
Gruß Luc :-?


  

Betrifft: AW: Abgesehen mal davon, dass hier .Cells(4... von: Walter
Geschrieben am: 23.01.2012 07:53:28

Hallo liebe Forum-Teilnehmer,
ich hatte leider keine Möglichkeit seit meiner Anfrage im Forum nachzusehen, daher die späte Reaktion.
Erstmal vielen Dank für die verschiedenen Lösungsmöglichkeiten. Ohne Eure Hilfe hätte ich dieses Problem wohl so schnell nicht lösen können. Dafür noch vielen, vielen Dank.
Ich werde sowohl die Matrix-Funktion wie auch die VBA-Lösung gründlich durchtesten.
Gruß
Walter


  

Betrifft: Hast du wirklich alles gelesen, ... von: Luc:-?
Geschrieben am: 23.01.2012 10:27:54

…Walter?
Es gäbe da ja noch eine VBA-Lösungsmöglichkeit, nämlich mit einer sog UDF, die du ganz normal in Zellfmln einsetzen könntest.
Gruß Luc :-?


  

Betrifft: AW: Hast du wirklich alles gelesen, ... von: Walter
Geschrieben am: 23.01.2012 10:56:07

Hallo Luc,

Kannst Du mir diese VBA-Lösung mal zeigen.
die andere VBA-Lösung scheint ja so zu funktionieren.
Ich muss es noch mit KD-Nr. bzw Auftragsnummern testen, die "0000" enthalten.

Gruß
Walter


  

Betrifft: Ja, kann ich, aber wie geschrieben, die ... von: Luc:-?
Geschrieben am: 24.01.2012 06:18:23

…Fkt sollte idR in einer TabBlatt-Formel verwendet wdn, Walter,
und ist deshalb in einem allgemeinen Modul der Mappe (oder deiner/m persönl Makro-Sammel-Datei bzw -AddIn) zu speichern. Folgende Fml könnte dann im TabBlatt verwendet wdn, um beide Werte auf 1x zurück­zugeben (kann auch anders gemacht wdn — probier mal!):
{=--TEIL(A2;{1;0}+{0;1}*VLike(A2;"*0000[1-9]*";-1);{-5;99}+{1;0}*VLike(A2;"*0000[1-9]*";1))}
Das ist eine MatrixFml*, die sich über 2 Zellen einer Spalte erstreckt. Die inneren {} umschließen Matrixkonstanten, müssen also mit eingegeben wdn, die äußeren nicht → sie entstehen bekanntlich automatisch*. Falls du die Werte in 2 Zellen einer Zeile ausgeben willst, musst du die ; der Matrixkonstanten durch . ersetzen, also zB {1.0}+{0.1}…
*Bitte ggf in der xlHilfe nachlesen!
Den hier folgenden Korpus der udFkt wie beschrieben speichern:

Rem Mxfmlfäh udFkt vgleicht Arg1 m.Suchmaske(Arg2) u.liefert Ergeb lt Arg3
'   Arg3=0(fehlt)->Wahrheitswt, =-1/+1->Anfangs-/EndPosition d.letzt Arg1-
'   TeilZeichenkette, f.d.sich noch 1 Vgl-Treffer ergibt. Mehr als 1 Tref-
'   fer liegt vor, falls Anfangs- > EndPosition ist! Arg2/3 müssen Skalare
'   sein or Arg1-Dimension haben, wobei Arg1 dann nur Vektor sein darf. In
'   dsn Fällen wird udFkt VPairs benötigt ->ggf d.PgmTeil auskommentieren!
'   Wn Arg1 Skalar ist, darf Arg2 ODER Arg3 ebenfalls beliebg Vektor sein.
'   Vs1.2 -LSr.CyWorXxl -cd: 20120121 -fpub: 20120124 herber.de -lupd: 20120121n
Function VLike(ByVal Bezug, ByVal TxMaske, Optional ByVal TxPosit = 0)
    Dim cix As Long, lb(1) As Long, pix As Long, rix As Long, ub(1) As Long, _
        lm(1) As Long, lp(1) As Long, um(1) As Long, up(1) As Long, _
        hVkt(2) As Boolean, avBez, erg(), txm, txp, xb As Variant
    On Error Resume Next
    If IsArray(TxMaske) Then
        If TypeName(TxMaske) = "Range" Then
            VLike = CVErr(xlErrRef)
            With WorksheetFunction
                TxMaske = .Transpose(.Transpose(TxMaske.Value2))
            End With
        Else: VLike = CVErr(xlErrNum)
        End If
        If IsError(LBound(TxMaske, 2)) Then
            hVkt(1) = True: lm(0) = LBound(TxMaske): um(0) = UBound(TxMaske)
            If um(0) - lm(0) = 0 Then txm = TxMaske(lm(0)) _
                Else txm = TxMaske
        Else: lm(0) = LBound(TxMaske, 2): um(0) = UBound(TxMaske, 2)
              lm(1) = LBound(TxMaske, 1): um(1) = UBound(TxMaske, 1)
            If um(0) - lm(0) = 0 Then
                If um(1) - lm(1) = 0 Then txm = TxMaske(lm(1), lm(0)) _
                    Else txm = TxMaske
            Else: Exit Function
            End If
        End If
    Else: txm = TxMaske
    End If
    If IsArray(TxPosit) Then
        If TypeName(TxPosit) = "Range" Then
            VLike = CVErr(xlErrRef)
            With WorksheetFunction
                TxPosit = .Transpose(.Transpose(TxPosit.Value2))
            End With
        Else: VLike = CVErr(xlErrNum)
        End If
        If IsError(LBound(TxPosit, 2)) Then
            hVkt(2) = True: lp(0) = LBound(TxPosit): up(0) = UBound(TxPosit)
            If up(0) - lp(0) = 0 Then txp = TxPosit(lp(0)) _
                Else txp = TxPosit
        Else: lp(0) = LBound(TxPosit, 2): up(0) = UBound(TxPosit, 2)
              lp(1) = LBound(TxPosit, 1): up(1) = UBound(TxPosit, 1)
            If up(0) - lp(0) = 0 Then
                If up(1) - lp(1) = 0 Then txp = TxPosit(lp(1), lp(0)) _
                    Else txp = TxPosit
            Else: Exit Function
            End If
        End If
    Else: txp = TxPosit
    End If
    If IsArray(Bezug) Then
        If TypeName(Bezug) = "Range" Then
            With WorksheetFunction
                avBez = .Transpose(.Transpose(Bezug.Value2))
            End With
        Else: avBez = Bezug
        End If
        If IsError(LBound(avBez, 2)) Then
            lb(0) = LBound(avBez): ub(0) = UBound(avBez)
            hVkt(0) = True: ReDim erg(ub(1) - lb(1))
        ElseIf IsArray(txm) Or IsArray(txp) Then
            If UBound(avBez, 2) - LBound(avBez, 2) = 0 Then
                ReDim erg(UBound(avBez, 1) - LBound(avBez, 1), 0)
            Else: VLike = CVErr(xlErrRef): Exit Function
            End If
        Else: lb(0) = LBound(avBez, 2): ub(0) = UBound(avBez, 2)
              lb(1) = LBound(avBez, 1): ub(1) = UBound(avBez, 1)
            ReDim erg(ub(1) - lb(1), ub(0) - lb(0))
        End If
        If IsArray(txm) And IsArray(txp) Then
            Exit Function
'            For Each xb In VPairs(avBez, txm, txp)
'                If Not IsNumeric(xb(2)) Then
'                    TxPosit = CInt(CBool(InStr(xb(2), "-"))) - CInt(CBool(InStr(xb(2), "+")))
'                Else: TxPosit = Sgn(xb(2))
'                End If
'                Bezug = xb(0): TxMaske = xb(1)
'                VLike = IIf(CBool(TxPosit), 0, False): GoSub ew
'            Next xb
        ElseIf IsArray(txm) Then
            Exit Function
'            If Not IsNumeric(txp) Then
'                TxPosit = CInt(CBool(InStr(txp, "-"))) - CInt(CBool(InStr(txp, "+")))
'            Else: TxPosit = Sgn(txp)
'            End If
'            For Each xb In VPairs(avBez, txm)
'                Bezug = xb(0): TxMaske = xb(1)
'                VLike = IIf(CBool(TxPosit), 0, False): GoSub ew
'            Next xb
        ElseIf IsArray(txp) Then
            Exit Function
'            TxMaske = txm
'            For Each xb In VPairs(avBez, txp)
'                If Not IsNumeric(xb(1)) Then
'                    TxPosit = CInt(CBool(InStr(xb(1), "-"))) - CInt(CBool(InStr(xb(1), "+")))
'                Else: TxPosit = Sgn(xb(1))
'                End If
'                Bezug = xb(0): VLike = IIf(CBool(TxPosit), 0, False): GoSub ew
'            Next xb
        Else: TxMaske = txm
            If Not IsNumeric(txp) Then
                TxPosit = CInt(CBool(InStr(txp, "-"))) - CInt(CBool(InStr(txp, "+")))
            Else: TxPosit = Sgn(txp)
            End If
            For Each Bezug In avBez
                VLike = IIf(CBool(TxPosit), 0, False): GoSub ew
            Next Bezug
        End If
        VLike = erg
    ElseIf IsArray(txm) And IsArray(txp) Then
        Exit Function
    ElseIf IsArray(txm) Then
        If Not hVkt(1) Then
            ReDim erg(um(1) - lm(1), um(0) - lm(0))
        Else: ReDim erg(um(0) - lm(0))
        End If
        If Not IsNumeric(txp) Then
            TxPosit = CInt(CBool(InStr(txp, "-"))) - CInt(CBool(InStr(txp, "+")))
        Else: TxPosit = Sgn(txp)
        End If
        avBez = Bezug: hVkt(0) = hVkt(1)
        lb(0) = lm(0): ub(0) = um(0): lb(1) = lm(1): ub(1) = um(1)
        For Each TxMaske In txm
            VLike = IIf(CBool(TxPosit), 0, False): GoSub ew
        Next TxMaske
        VLike = erg
    ElseIf IsArray(txp) Then
        If Not hVkt(2) Then
            ReDim erg(up(1) - lp(1), up(0) - lp(0))
        Else: ReDim erg(up(0) - lp(0))
        End If
        avBez = Bezug: hVkt(0) = hVkt(2)
        lb(0) = lp(0): ub(0) = up(0): lb(1) = lp(1): ub(1) = up(1)
        For Each TxPosit In txp
            If Not IsNumeric(TxPosit) Then
                TxPosit = CInt(CBool(InStr(TxPosit, "-"))) - CInt(CBool(InStr(TxPosit, "+")))
            Else: TxPosit = Sgn(TxPosit)
            End If
            VLike = IIf(CBool(TxPosit), 0, False): GoSub ew
        Next TxPosit
        VLike = erg
    Else: TxMaske = txm
        If Not IsNumeric(txp) Then
            TxPosit = CInt(CBool(InStr(txp, "-"))) - CInt(CBool(InStr(txp, "+")))
        Else: TxPosit = txp
        End If
ew:     If IsError(Bezug) Then
            VLike = Bezug
        ElseIf Bezug Like TxMaske Then
            Select Case TxPosit
            Case -1
                For pix = 1 To Len(Bezug)
                    If Not Mid(Bezug, pix) Like TxMaske Then Exit For
                Next pix
                VLike = pix - 1
            Case 0: VLike = True
            Case 1
                For pix = Len(Bezug) To 1 Step -1
                    If Not Left(Bezug, pix) Like TxMaske Then Exit For
                Next pix
                VLike = pix + 1
            End Select
        End If
        If Not IsEmpty(avBez) Then
            If Not hVkt(0) Then
                erg(rix, cix) = VLike
                rix = (rix + 1) Mod (ub(1) + 1 - lb(1))
                cix = cix - CInt(rix = 0)
            Else: erg(cix) = VLike: cix = cix + 1
            End If
            Return
        End If
    End If
End Function
Die PgmTeile, die bei dir nicht fktn würden, habe ich auskommentiert. Das ist mit einer gewissen Einschränkung der Universalität der Fkt verbunden, aber ich glaube, damit kannst du leben.
Gruß Luc :-?


  

Betrifft: AW: Abgesehen mal davon, dass hier .Cells(4... von: Walter
Geschrieben am: 23.01.2012 11:02:50

Hallo Luc,

Du hast recht, wenn die Auftragsnummer "0000" enthäst funktioniert es nicht.

Walter


Beiträge aus den Excel-Beispielen zum Thema "String splitten"