從Excel單元格中提取多個子字串

從Excel單元格中提取多個子字串

我有一個格式非常糟糕的列,其中每個單元格可以包含零個或一個或多個條目,如下所示(這個包含兩個):

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

我需要將 11 個字串提取到一個單獨的列中,最好使用公式。對於上面的單元格,它應該如下所示:

ACTI-U-9754
MDCF-U-9791

我還沒有找到處理這種特定場景的範例。

答案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

在此輸入影像描述

相關內容