使用另一列中的字符串数据添加多个列

Question

此程序在列D中的字符串中放置一个名称。如何为具有2个名称的字符串引入列F？ G列可以用于第3个吗？

Sub name1() 'Main Program

Dim nmArr()
Dim i As Long
Dim cl As Range

Set cl = ActiveSheet.Range("D2") '## This is the STARTING cell

'## This is the list of names built as an array
nmArr = Array("Christy", "Kari", "Sue", "Clayton", "DanK", "Gawtry", Holly", "John", "Matt", "Dustin", "David")
Do
    For i = LBound(nmArr) To UBound(nmArr)
        If InStr(1, cl.Value, nmArr(i), vbTextCompare) Then
            cl.Offset(0, 1).Value = nmArr(i)
            Exit For
        End If
    Next

    '## Get a handle on the NEXT cell
    Set cl = cl.Offset(1, 0)
Loop Until Trim(cl.Text) = vbNullString
outcome1

End Sub

@Scottcramer：这是我的数据......

Answer 1

这将分割,上的数据然后测试每个部分（如果它在数组中）并输出E，G，H中的每个名称

Sub name1dd() 'Main Program

Dim nmArr()
Dim i As Long, j As Integer
Dim cl As Range
Dim splArr() As String
Dim nm As Variant

Set cl = ActiveSheet.Range("D2") '## This is the STARTING cell

'## This is the list of names built as an array
nmArr = Array("Christy", "Kari", "Sue", "Clayton", "DanK", "Gawtry", "Holly", "John", "Matt", "Dustin", "David")

Do
    j = 1
    splArr = Split(cl.Value, ",")
    For Each nm In splArr
        For i = LBound(nmArr) To UBound(nmArr)
            If InStr(1, nm, nmArr(i), vbTextCompare) Then
                cl.Offset(0, j).Value = nmArr(i)
                If j = 1 Then
                    j = j + 2
                Else
                    j = j + 1
                End If
                Exit For
            End If
        Next i
    Next nm

    '## Get a handle on the NEXT cell
    Set cl = cl.Offset(1, 0)
Loop Until Trim(cl.Text) = vbNullString
outcome1

End Sub