如何从数组中解析和过滤掉子字符串中的唯一名称？

你没有回答我的澄清问题......

请复制 Excel 标准模块中的下一个代码并运行第一个 （）。该代码假设我在评论中表达的理解是正确的：SubextractNamesArr

Sub extractNamesArr()
  Dim arrN, arrFin, arr, mtch, strRepl As String, i As Long, j As Long, boolNot As Boolean
  arrN = Split("JohnJacob,George,JacobBill,GeorgeBill,PatZach,BobJacob,MichaelScottChristine", ",")
  
  arr = extractNB(arrN) 'create an array of twp dictionaries
                                        '1. above array elements (as keys) and all extracted names (as item) per each key
                                        '2. all unique extracted names, as dictionary keys
  Debug.Print Join(arr(0).Keys, "|") ' just to visually see the dictionary keys
  arrFin = arr(1).Keys               'place in an array the unique extracted names
  
  Dim key, k
  For Each key In arr(0).Keys        'iterate between the dictionary keys
        For i = 0 To UBound(arr(0)(key))
            For Each k In arr(0).Keys
                If key <> k Then
                    If InStr(1, k, arr(0)(key)(i), vbBinaryCompare) > 0 Then
                        boolNot = True: Exit For
                    End If
                End If
            Next k
            If boolNot Then Exit For
        Next i
        If Not boolNot Then 'none of the names belonging to the respective kay, NOT FOUND
            For j = 0 To UBound(arr(0)(key))
                mtch = Application.match(arr(0)(key)(j), arrFin, 0)
                If j = UBound(arr(0)(key)) Then
                      arrFin(mtch - 1) = key
                Else
                    strRepl = arrFin(mtch - 1) & "@#$%": arrFin(mtch - 1) = strRepl
                    arrFin = filter(arrFin, strRepl, False)
                End If
            Next j
        End If
        boolNot = False
  Next key

  Debug.Print Join(arrFin, "|") 'just to see the final returned array (unique names)
End Sub

Function extractNB(arr) As Variant
   Dim arrInt, k As Long, El, i As Long, frstEl As Long
   Dim dict As Object, dict1 As Object
   
   Set dict = CreateObject("Scripting.Dictionary")  'dictionary to keep all initial composed array elements (as key) and its split names (as item)
   Set dict1 = CreateObject("Scripting.Dictionary") 'dictionary to keep UNIQUE  extracted names
   
   frstEl = 1                     'first letter to build the first name string
   For Each El In arr             'iterate between the array elements
        ReDim arrInt(Len(El))     'ReDim the intermediary array to the string number of digits
        For i = 2 To Len(El)      'iterate between string characters, starting from the second one:
            If isUpper(Mid(El, i, 1)) Then                        'if the character is Upper case:
               arrInt(k) = Mid(El, frstEl, i - frstEl): k = k + 1 'place the Name inthe intermediary dictionary item array
               dict1(arrInt(k - 1)) = vbNullString                'load the dictionary to keep all UNIQUE extracted names
               frstEl = i          'adapt the first character number, to extract the next name
            End If
        Next i
        If frstEl < i - 1 Then     'extract the last name:
            arrInt(k) = Mid(El, frstEl, Len(El) - frstEl + 1): k = k + 1
            dict1(arrInt(k - 1)) = vbNullString                           'load the dictionary keeping all UNIQUE extracted names
        End If
        ReDim Preserve arrInt(k - 1)    'keep only the loaded array elements
        dict.Add El, arrInt             'create the dictionary key and its array item
        frstEl = 1: Erase arrInt: k = 0 'reinitialize the necessary variables
   Next

   extractNB = Array(dict, dict1)  'return an array containing the two dictionaries
End Function

Function isUpper(mstr As String) As Boolean 'Check if the  character is Upper case
    Select Case Asc(mstr)
            Case 65 To 90
                isUpper = True
            Case 97 To 122
                isUpper = False
            Case Else
                isUpper = False
    End Select
End Function

请在测试后发送一些反馈。如果有什么不清楚的地方，请随时要求澄清。

我尝试注释所有不容易理解的代码行......