Excel セルから複数の部分文字列を抽出する

Question

次のように、各セルに 0 個または 1 個以上のエントリを含めることができる、ひどくフォーマットされた列があります (この列には 2 個含まれています)。

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

できれば数式を使用して、11 個の文字列を別の列に抽出する必要があります。上記のセルの場合は次のようになります。

ACTI-U-9754
MDCF-U-9791

この特定のシナリオを扱う例は見つかりませんでした。

Answer 1

簡単な数式メソッドは思いつきませんでしたが、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