Extrahieren Sie mehrere Teilzeichenfolgen aus einer Excel-Zelle

Question

Ich habe eine schrecklich formatierte Spalte, in der jede Zelle null oder einen oder mehrere Einträge enthalten kann, wie die folgenden (diese enthält zwei):

ACTI-U-9754 - Some description MDCF-U-9791 - Some other description

Ich muss die 11 Zeichenketten in eine separate Spalte extrahieren, am besten mit einer Formel. Für die Zelle oben sollte das so aussehen:

ACTI-U-9754
MDCF-U-9791

Ich habe keine Beispiele gefunden, die sich mit diesem speziellen Szenario befassen.

Answer 1

Leider ist mir keine einfache Formelmethode eingefallen, aber hier ist eine VBA-Methode mit RegEx, falls sie Ihnen von Nutzen sein sollte. Das RegEx-Muster geht davon aus, dass die Codes immer gleich sind, 4 letters - 1 letter - 4 digitsSie können sie natürlich nach Bedarf ändern. Wenn die Annahme von Buchstaben und Ziffern falsch ist, das Format aber immer 4-1-4 ist, können Sie .{4}\-.\-.{4}stattdessen Folgendes verwenden:

Sub GetCodes()
    Dim strPattern: strPattern = "\w{4}\-\w\-\d{4}"   'Pattern to match
    Dim colNumber: colNumber = 1                        'Column number containing strings (In this case, 1, for column A)
    Dim rowCount: rowCount = 1                          'Row number to start from
    Range("B1").Select                                  'Cell to start new column from

    'Create a new RegEx engine instance
    Dim rgx: Set rgx = CreateObject("vbscript.regexp")

    'Set out RegEx instance to allow Global (More than 1 result per text), MultiLine (Incase there are any carriage returns in the cell), IgnoreCase (Allow both upper and lowercase, which isn't needed with \w but included to be sure) and Pattern, the patter defined above.
    With rgx
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = strPattern
    End With

    'Begin a loop that ends once we hit an empty cell
    Do
        'Get all our RegEx matches and store them in rgxMatches
        Dim rgxMatches: Set rgxMatches = rgx.Execute(Cells(rowCount, colNumber).Value)
        Dim rgxMatch
        'Loop through our matches
        For Each rgxMatch In rgxMatches
            'Write the match into the active cell
            ActiveCell.Value = rgxMatch.Value
            'Go down one row, ready to write the next cell if there is one
            ActiveCell.Offset(1, 0).Select
        Next

        'Increment our row count so the next loop uses the next row
        rowCount = rowCount + 1
    Loop Until IsEmpty(Cells(rowCount, colNumber))

    'Clean up after
    Set rgx = Nothing
    Set rgxMatches = Nothing
End Sub