Kann ich das loopen?

Question

Mit einer Zeitschleife dieses; D2 ist der Ort, an dem die Liste beginnt. Ich würde es gerne für d3, d4, d5, d6 .... bis zu einem Leerzeichen laufen lassen.

Auch werde ich die Daten in Spalte E platzieren und das müsste auch wie Spalte D erhöhen; 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

Ja, definieren einen Bereich Schleife über, und dann kann man es so tun, eine innere Schleife über die Liste der Namen mit:

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 

oberhalb des Bereichs erfordert hartzucodieren, aber wenn Sie es brauchen nur zu tun , bis es eine leere Zelle findet, t Henne ändern wie folgt:

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 

Zweiter Ansatz & arbeiten zu produzieren Ausgänge wie getestet wurde:

Answer 2

Ja, Sie können, legen Sie die Namen in einem Array dann die Schleife durch das Array .:

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