Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1428to1432
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Regulärer Ausdruck, in Zellen aufteilen

VBA: Regulärer Ausdruck, in Zellen aufteilen
06.06.2015 20:18:17
Emre
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

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

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

AW: VBA: Regulärer Ausdruck, in Zellen aufteilen
07.06.2015 10:47:47
Emre
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

AW: VBA: Regulärer Ausdruck, in Zellen aufteilen
07.06.2015 11:35:29
Emre
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

Anzeige
AW: VBA: Regulärer Ausdruck, in Zellen aufteilen
07.06.2015 13:31:51
Emre
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

Anzeige
AW: VBA: Regulärer Ausdruck, in Zellen aufteilen
07.06.2015 23:39:57
ransi
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

Anzeige
AW: VBA: Regulärer Ausdruck, in Zellen aufteilen
08.06.2015 15:13:36
Emre
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

Anzeige
AW: VBA: Regulärer Ausdruck, in Zellen aufteilen
08.06.2015 17:33:46
ransi
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

AW: VBA: Regulärer Ausdruck, in Zellen aufteilen
08.06.2015 18:35:42
Emre
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

322 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige