一个用户定义函数的轻微调整(Slight adaptation of a User Defined

我想从位于在Excel列中较大的字符串中提取文本和数字的组合。

我有工作的常量是每个文字串

•无论是用A，C或S开头，并且•永远是7个字符长•我想提取他改变字符串的位置

我一直在使用它的代码已经工作效率是;

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

不过今天我已经学会了，有时我的数据可能包括这样的场景;

我想是这样如果第8字符是“下划线”和7个字符的第一个字符是S，A或C，请提取直到“下划线”，以适应我的代码

其次，我想排除像“支持”和被提取的“收藏”公地的话。

最后，7号信令应该是一个数

解决这个任何想法，将不胜感激。

谢谢

Answer 1:

尝试这个

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

测试

Answer 2:

加入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

ISIT可能因此如果第7个字符为字母返回空白，以ammend这个代码？

与分配替换线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}[AZ]_?)来拒绝SUTP03A_MDC_3 。 但要注意：在拒绝规则正好适用于第7个字符。 现在v_re.IgnoreCase设置为True ，但如果只输入大写字符是允许的，将其设置为False 。 另请参见正则表达式语法在MSDN上。

文章来源: Slight adaptation of a User Defined Function