我可以循环吗？

Question

有一个时间循环这个; D2是列表开始的位置。我想让它跑到d3，d4，d5，d6 ....直到一个空白区域。

另外，我将数据放入E列，这也需要像D列一样增加; E2，E3，E4，E5，E6 ...

Sub james() 'Main Program
Dim celltxt As String
celltxt = ActiveSheet.Range("D2").Value

DELETE_EJ

If InStr(1, celltxt, "Christy", vbTextCompare) Then
    Range("E2").Value = "Christy"

ElseIf InStr(1, celltxt, "Kari", vbTextCompare) Then
    Range("E2").Value = "Kari"

ElseIf InStr(1, celltxt, "Sue", vbTextCompare) Then
    Range("E2").Value = "Sue"

ElseIf InStr(1, celltxt, "Clayton", vbTextCompare) Then
    Range("E2").Value = "Clayton"

Answer 1

是的，定义一个要循环的范围，然后你可以这样做，使用名称列表上的内部循环：

Sub foo() 'Main Program

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

'## This is the range you will loop over
Set loopRange = ActiveSheet.Range("D2:D6") '## Modify as needed

'## This is the list of names built as an array
nmArr = Array("Christy", "Kari", "Sue", "Clayton")

DELETE_EJ

For Each cl in loopRange.Cells
    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
Next 

End Sub

上面要求对范围进行硬编码，但如果您需要直到找到空白单元格，则修改如下：

Option Explicit
Sub foo() '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")

DELETE_EJ

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

End Sub

已经测试了第二种方法＆amp;努力产生如下产出：

Answer 2

是的，你可以把名字放在一个数组中，然后循环遍历数组。：

Sub james() 'Main Program
Dim celltxt As String
Dim nmArr()

nmArr = Array("Christy", "Kari", "Sue", "Clayton")
celltxt = ActiveSheet.Range("D2").Value

DELETE_EJ
For i = LBound(nmArr) To UBound(nmArr)
    If InStr(1, celltxt, nmArr(i), vbTextCompare) Then
        Range("E2").Value = nmArr(i)
        Exit For
    End If
Next i

End Sub