提取字符串中的预定义名称

Question

我有一个信息栏。我需要检查每个单元格的内容，以查看哪个用户帐户发送了该信息。每个单元格中的文本通常包含用户名，但没有设置格式。

我有所有用户名的列表（名称范围为“帐户”）。

我们提取每个单元格中的用户名的计划是使用自定义Excel VBA函数执行以下操作：

1. 查找所有用户名的文本长度的最小值和最大值（以最小化要检查的提取文本的长度）
2. 遍历单元格内容以将其提取为具有不同提取长度的各种提取文本）
3. 使用Vlookup和用户名列表比较各种提取的文本（从单元格内容中提取）
4. 如果单元格中提取的文本与用户名匹配，请将其保存为值
5. 如果一个单元格中有多个匹配的文本，请仍然将它们保存为一个值，并用特殊字符（“ /”）隔开

该函数显示错误。

Function EXTRACTNICK(MinLen As Integer, MaxLen As Integer, checktext As String)

Dim i As Integer
Dim textLen As Integer
Dim extractText As String
Dim Str As String

Str = ""

    For textLen = MinLen To MaxLen
        For i = 1 To (Len(checktext) - textLen + 1)
            extractText = Mid(checktext, i, textLen)
            If IsError(WorksheetFunction.VLookup(extractText, Range("Accounts"), 1, False)) Then
                Str = Str
            Else
                Str = Str & " / " & extractText
            End If
        Next i
    Next textLen

ExtractNickName = Str

End Function

Answer 1

在照片中，假设我的黄色范围等于您命名的范围Accounts

---

Option Explicit

Public Function Extracting(name As Range) As String

Dim Arr, i As Long
Arr = Sheets("Sheet1").Range("A1:A10").Value

For i = LBound(Arr) To UBound(Arr)
    If InStr(name, Arr(i, 1), 0) Then
        Extracting = Extracting & Arr(i, 1) & "/"
    End If
Next i

If Extracting = "" Then
    Extracting = "No Users Found"
Else
    Extracting = Left(Extracting, Len(Extracting) - 1)
End If

End Function

---