Excel 셀에서 여러 부분 문자열 추출

나는 각 셀이 다음과 같은 하나 또는 그 이상의 항목을 포함 할 수있는 끔찍한 형식의 열이 있습니다 (이 중 하나에는 두 개가 포함됨).

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

11 개의 문자열을 별도의 열로 추출해야하며, 수식을 사용하는 것이 더 바람직합니다. 위의 셀에는 다음과 같이 표시되어야합니다.

ACTI-U-9754
MDCF-U-9791

이 특정 시나리오를 다루는 예제를 찾지 못했습니다.

나는 단순한 수식 방법을 생각할 수 없다는 것이 두려운 것이지만, RegEx를 사용하는 VBA 방법은 당신에게 어떤 용도로든 사용할 수 있기 때문에 여기에 있습니다. RegEx 패턴은 코드가 항상 같다고 가정 4 letters - 1 letter - 4 digits합니다. 물론 필요에 따라 수정할 수 있습니다. 문자와 숫자의 가정이 잘못되었지만 형식이 항상 4-1-4 인 경우 .{4}\-.\-.{4}대신 다음을 사용할 수 있습니다 .

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