用户定义函数的轻微调整

Question

我想从位于 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 个字符是 "Underscore" 并且 7 个字符中的第一个字符是 S、A 或 C，请提取直到 "Underscore"

其次，我想排除像 "Support" & "Collect" 这样的常用词被提取。

最后第 7 个字母应该是一个数字

如有任何想法，我们将不胜感激。

谢谢

Answer 1

将 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

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

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

UPD

Isit possible to ammend this code so if the 7th character is a letter to return blank?

将分配给 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 上的 Regular Expression Syntax。

Answer 2

试试这个

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

或

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

两种变体的结果相同

测试

更新

Do you know how I could leave the result blank if the 7th character returned a letter?

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

测试

用户定义函数的轻微调整

Slight adaptation of a User Defined Function

regex

excel

vba

user-defined-functions

udf