1

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

The code I have been using which has been working efficiently is;

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
Xtractor = ""
End Function

However today I have learnt that sometimes my data may include scenarios like this;

enter image description here

What I would like is to adapt my code so If the 8th character is "Underscore" and the 1st character of the 7 characters is either S, A or C please extract up until the "Underscore"

Secondly I would like to exclude commons words like "Support" & "Collect" from being extracted.

Finally the 7th letter should be a number

Any ideas around this would be much appreciated.

Thanks

4

2 回答 2

0

添加Microsoft VBScript Regular Expressions 5.5到项目引用。使用以下代码测试 Xtractor 的匹配和提取:

Public Function Xtractor(ByVal p_val As String) As String
  Xtractor = ""
  Dim ary As String, v_re As New VBScript_RegExp_55.RegExp, Matches
  v_re.Pattern = "^([SAC][^_]{1,6})_?"
  Set Matches = v_re.Execute(p_val)
  If Matches.Count > 0 Then Xtractor = Matches(0).SubMatches(0) Else Xtractor = ""
End Function
Sub test_Xtractor(p_cur As Range, p_val As String, p_expected As String)
  Dim v_cur As Range, v_res As Range
  p_cur.Value = p_val
  Set v_cur = p_cur.Offset(columnOffset:=1)
  v_cur.FormulaR1C1 = "='" & ThisWorkbook.Name & "'!Xtractor(RC[-1])"
  Set v_res = v_cur.Offset(columnOffset:=1)
  v_res.FormulaR1C1 = "=RC[-1]=""" & p_expected & """"
  Debug.Print p_val; "->"; v_cur.Value; ":"; v_res.Value
End Sub
Sub test()
  test_Xtractor ActiveCell, "A612002_MDC_308", "A612002"
  test_Xtractor ActiveCell.Offset(1), "B612002_MDC_308", ""
  test_Xtractor ActiveCell.Offset(2), "SUTP038_MDC_3", "SUTP038"
  test_Xtractor ActiveCell.Offset(3), "KUTP038_MDC_3", ""
End Sub

选择用于编写测试夹具的工作簿和单元格,然后test从 VBA 编辑器运行。
立即窗口中的输出 (Ctrl+G):

A612002_MDC_308->A612002:True
B612002_MDC_308->:True
SUTP038_MDC_3->SUTP038:True
KUTP038_MDC_3->:True

UPD

如果第 7 个字符是返回空白的字母,是否可以修改此代码?

将行替换v_re为以下内容:

v_re.Pattern = "^([SAC](?![^_]{5}[A-Z]_?)[^_]{1,6})_?"
v_re.IgnoreCase = True

并添加到test套件中:

test_Xtractor ActiveCell.Offset(4), "SUTP03A_MDC_3", ""

输出:

A612002_MDC_308->A612002:True
B612002_MDC_308->:True
SUTP038_MDC_3->SUTP038:True
KUTP038_MDC_3->:True
SUTP03A_MDC_3->:True

我插入了否定的前瞻性子规则(?![^_]{5}[A-Z]_?)来拒绝SUTP03A_MDC_3。但请注意:拒绝规则恰好适用于第 7 个字符。现在v_re.IgnoreCase设置为True,但如果只允许大写字符,请将其设置为False。另请参阅MSDN 上的正则表达式语法

于 2015-06-10T14:57:15.710 回答
0

尝试这个

ary = Split(Replace(r.Text, "_", " "))

或者

ary = Split(Replace(r.Text, "_", " ")," ")

两种变体的结果相同

测试

在此处输入图像描述

更新

你知道如果第 7 个字符返回一个字母,我怎么能把结果留空?

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

测试

在此处输入图像描述

于 2015-06-10T15:52:54.783 回答