如何通过VBA或Excel公式从文本字符串中提取特定的字母和数字

Question

I would like to extract a combination of text and numbers from a larger string located within a column within excel.

The constants I have to work with is that each Text string will

• either start with a A, C or S, and
• will always be 7 Characters long
• the position of he string I would like to extract varies.

For example;

COB0012 WP0402 Electronic Payments - SME Consultancy
DCPY708 A850035 WP161 Configuration Manager Core General (Aman Ranjan) A614019 WP0302 SQL 2005 Upgrade Project – WFCopiesChq - Next Stage SUTP016 EPM Training T2

Output

COB0012
A850035
SUTP016

I have knowledge of the standard Left / Right / Mid / Search functions however my data set is vary large so I would like to create something which would automate this process. (1000's of rows)

I imagine a UDF function would do the trick but my familarity with UDF's is very basic.

Any help would be much appreciated.

Answer 1

Consider:

Public Function Xtractor(r As Range) As String
   Dim CH As String, L As Long
   ary = Split(r.Text, " ")
   For Each a In ary
      L = Len(a)
      CH = Left(a, 1)
      If L = 7 Then
         If CH = "S" Or CH = "A" Or CH = "C" Then
            Xtractor = a
            Exit Function
         End If
      End If
   Next a
   Xtractor = ""
End Function

Answer 2

@Gary's Student variant but has some difference

Public Function Xtractor(r As Range) As String
    Dim a, ary
    ary = Split(r.Text, " ")
    For Each a In ary
        If Len(a) = 7 And a Like "[SAC]*" Then
            Xtractor = a
            Exit Function
        End If
    Next a
End Function

output

Answer 3

A regex will be very efficient - especially if you combine it with a variant array rather than a range.

Sub UseaRegex()
MsgBox StrChange("COB0012 WP0402 Electronic Payments - SME Consultancy [I would require COB0012]")
MsgBox StrChange("DCPY708 A850035 WP161 Configuration Manager Core General (Aman Ranjan)")
End Sub

function

Function StrChange(strIn As String) As String
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
    .Pattern = "[ACS]\w{6}"
     If .test(strIn) Then
        StrChange = .Execute(strIn)(0)
     Else
        StrChange = "No match"
     End If
End With
End Function