VBA: Regulärer Ausdruck, in Zellen aufteilen

Bild

Betrifft: VBA: Regulärer Ausdruck, in Zellen aufteilen
von: Emre
Geschrieben am: 06.06.2015 20:18:17

Hallo,
das wird wohl mein vorerst letztes hallo für eine Weile sein, da die mir gestellte Aufgabe fast fertig ist.
Also, wie bereits wahrscheinlich bekannt, importiere ich verschiedene Werte aus einer .txt-Datei nach Excel in die Spalte A. Diese Werte sehen wie folgt aus:
Friedrich Peter (DD-DS/DAS2)
Mueller Hans (DD/OKL3)
Muster Ohr (ODSK/BHG1 DD/FGD2)
Wie gesagt sind diese Werte in der Spalte A. Jetzt muss ich diese Werte, am besten mit einem regulären Ausdruck in die nebenstehenden Zellen aufteilen. Das heißt,
Spalte A
List
(Die oberen Werte)
Spalte B
Nachname
Friedrich
Mueller
Muster
Spalte C
Vorname
Peter
Klaus
Ohr
Spalte D
Di1
DD-DS
DD
ODSK
Spalte E
De1
DAS
OKL
BHG
Spalte F
Di2
DD
Spalte G
De2
FGD
Spalte H
Gr
2
3
2
Und so soll das ganze weiter gehen. Erste Frage, ist das möglich, durch einen regulären Ausdruck diese Werte in die nebenstehenden Zellen zu schreiben. Einen Code habe ich wieder Mal gefunden, konnte ihn wieder mal nicht so anpassen wie nötig. Das hier wäre der Code:

Sub Aufteilen()
' Late-Bound | Early-Bound
Dim REX As Object ' RegExp
Dim oMatchCollection As Object ' MatchCollection
Dim oMatch As Object ' Match
Dim aryVals As Variant
Dim n As Long
Set REX = CreateObject("VBScript.RegExp")
With REX
.Global = True
.IgnoreCase = False
.Pattern = "(.*)"
End With
With Tabelle1.Range(Tabelle1.Cells(1), Tabelle1.Cells(Tabelle1.Rows.Count, 1).End(xlUp))
aryVals = .Value
For n = LBound(aryVals) To UBound(aryVals, 1)
If REX.test(aryVals(n, 1)) Then
Set oMatchCollection = REX.Execute(aryVals(n, 1))
For Each oMatch In oMatchCollection
aryVals(n, 1) = "Auto"
Next
End If
Next
.Value = aryVals
End With
End Sub
Gruß Emre

Bild

Betrifft: AW: VBA: Regulärer Ausdruck, in Zellen aufteilen
von: ransi
Geschrieben am: 07.06.2015 09:48:36
Hallo,
Muster Ohr (ODSK/BHG1 DD/FGD2)
Die "1" soll nicht ausgegeben werden ?
ransi

Bild

Betrifft: AW: VBA: Regulärer Ausdruck, in Zellen aufteilen
von: Emre
Geschrieben am: 07.06.2015 10:47:47
Hallo ransi,
das ist so eine Sache, da Werte wie dieser in der Liste eher seltener sind, denk ich mir, nur eine Nummer würde ausreichen und eine extra Spalte für die zweite Nummer zu erstellen wäre zu viel.
Gruß Emre

Bild

Betrifft: AW: VBA: Regulärer Ausdruck, in Zellen aufteilen
von: Emre
Geschrieben am: 07.06.2015 11:35:29
Hallo zusammen,
ich habe das Problem vom ersten Beitrag jetzt fast fertig, nur ohne den regulären Ausdrücken. Dadurch ist mein Code aber sehr sehr lang geworden wie ich finde und ich habe auch mehrere Sub's erstellen müssen.
Jetzt fehlt mir eigentlich nur noch eine letzte Sache und vielleicht die ganzen Sub's die ich momentan habe in ein großes Sub zusammenzufassen.
Ich bräuchte eine (glaube ich mal) If-Anweisung, die mir folgendes macht. Wenn sich in Spalte E, F, G eine Zahl befindet, soll diese Zahl von aus jeweiliger Zelle/Spalte ausgeschnitten und in die gleiche Zelle in Spalte H eingefügt werden.
Habe verschiedene Sachen gefunden, ich weiß auch dass es mit IsNumeric funktionieren soll aber konnte keine Schleife mit so einer If-Bedingung erstellen.
Gruß Emre

Bild

Betrifft: AW: VBA: Regulärer Ausdruck, in Zellen aufteilen
von: Emre
Geschrieben am: 07.06.2015 13:31:51
Hallo,
habe es fast, der untere Code macht so ziemlich was ich benötige, jedoch werden auch Strings ausgeschnitten und ab "H2" eingefügt. Ich bräuchte aber nur Zahlen die ausgeschnitten und ab "H2" eingefügt werden und die Strings bleiben einfach da wo sie auch sind.
Was muss ich hier noch ändern?

Sub AusschneidenUndErsetzen()
    Dim rngZelle As Range
    
    For Each rngZelle In Range("H2:H2000")
        'Wenn jede Zahl ersetzt werden soll
        
           If IsNumeric(rngZelle) Then
             Range("E2:G2000").Cut Destination:=Range("H2")
          
        End If
     Next rngZelle
End Sub


Bild

Betrifft: AW: VBA: Regulärer Ausdruck, in Zellen aufteilen
von: ransi
Geschrieben am: 07.06.2015 23:39:57
Hallo,
Teste mal:

Option Explicit

Sub machs()
    Dim out As Variant
    Dim arrIn As Variant
    Dim regex As Object
    Dim element
    Dim strTmp As String
    Dim objM As Object, I As Integer, L As Long
    arrIn = Range("A2:A5") 'anpassen
    
    Redim arrout(1 To UBound(arrIn), 1 To 7)
    Set regex = CreateObject("VbScript.Regexp")
    
    With regex
        For Each element In arrIn
            strTmp = element
            .Pattern = "\d+ (?=[A-ZÄÖÜ])"
            .Global = True
            If .test(element) = True Then
                strTmp = .Replace(element, "###")
            End If
            .Pattern = "( \(|\/| |\d+ |\$)"
            strTmp = .Replace(strTmp, "###")
            .Pattern = "\)$"
            strTmp = .Replace(strTmp, "")
            .Pattern = "\d(?=$)"
            Set objM = .Execute(strTmp)
            strTmp = .Replace(strTmp, "###" & objM(0).Value)
            out = Split(strTmp, "###")
            L = L + 1
            arrout(L, 7) = out(UBound(out))
            For I = 0 To UBound(out) - 1
                arrout(L, I + 1) = out(I)
            Next
        Next
    End With
    Range("B2").Resize(UBound(arrout), UBound(arrout, 2)) = arrout
End Sub


ISt zwar "mit der heißen Nadel gestrickt" (keine Fehlerbehandlung, keine Kommentare), aber mit deinen Beispieldaten klappt es.
Tabelle1

 ABCDEFGHI
2Friedrich Peter (DD-DS/DAS2)FriedrichPeterDD-DSDAS  2 
3Mueller Hans (DD/OKL3)MuellerHansDDOKL  3 
4Muster Ohr (ODSK/BHG1 DD/FGD2)MusterOhrODSKBHGDDFGD2 
5         


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
ransi

Bild

Betrifft: AW: VBA: Regulärer Ausdruck, in Zellen aufteilen
von: Emre
Geschrieben am: 08.06.2015 15:13:36
Hallo ransi,

es klappt, vielen Dank dafür, aber ein paar Fragen hätte ich noch. Die "Aufteilung" der Spalte A soll bis zur letzten Zelle die einen Wert hat ausgeführt werden. Dazu habe ich UsedRange.SpecialCells(xlCellTypeLastCell).Row statt Range("A2:A5") eingefügt aber habe ne Fehlermeldung bekommen.

Jetzt ist es so, dass manche Personen in der Liste auch 2, 3 oder sogar 4 Vornamen besitzen, wie kann man da die Aufteilung anpassen? Es würde auch gehen, wenn der gesamte Name nur in eine Spalte kommt, also ohne die Aufteilung von Vor- und Nachnamen. Also der gesamte Name bis zur ersten Klammer in die Spalte C zum Beispiel.

Und eine letzte Sache wäre,

Max Luter Mustermann (FF-DS/DKO1-SP)

Der obere Wert hat 2 Vornamen, die Aufteilung der Klammer wäre FF-DS DKO 1 ESP

Das ESP am Ende steht für das Land und sollte in eine neue Spalte B eingefügt werden. Also ESP = Spanien, aber nicht als ESP sondern als Spanien ausgeschrieben und dann als Kürzel verschwinden. Das ist auf mehrere Länder bezogen, die das Kürzel am Ende haben.

Friedrich Peter (DD-DS/DAS2) zum Beispiel, hat kein Länderkürzel am Ende, sondern am Anfang das DD. Dieses DD sollte dann in Spalte B als Deutschland eingefügt werden. Ich glaube eine If-Bedingung würde das machen, aber wo ich die im Code dann einfüge weiß ich nicht.

Dadurch, dass es jetzt eine neue Spalte B mit Land gibt, verschiebt sich auch alles eine Spalte weiter. Das ist jetzt recht viel auf einmal, aber wenn du mir Tipps geben könntest wie ich das realisieren könnte, würde mir das sehr weiter helfen.


Gruß Emre


Bild

Betrifft: AW: VBA: Regulärer Ausdruck, in Zellen aufteilen
von: ransi
Geschrieben am: 08.06.2015 17:33:46
Hallo Emre,
Lade doch einfach mal ne Beispieldatei hoch die alle Eventualitäten enthält.
DAnn kann man den Code einmal vernünftig schreiben.
Nachträglich da was reinzufrickeln ist immer blöd und verkompliziert das GAnze unnötig.
ransi

Bild

Betrifft: AW: VBA: Regulärer Ausdruck, in Zellen aufteilen
von: Emre
Geschrieben am: 08.06.2015 18:35:42
Hallo ransi,
ja das hast du recht. Ich hab mal eine Test-Datei hochgeladen. Die Datei zeigt das Endergebnis, so wie aussehen sollte, die habe ich manuell in die passenden Zellen geschrieben.
https://www.herber.de/bbs/user/98084.xlsm
Gruß Emre

 Bild

Beiträge aus den Excel-Beispielen zum Thema "VBA: Regulärer Ausdruck, in Zellen aufteilen"