使用For /每个循环，但跳跃活动单元格VBA

Question

所以我想写一个For Each循环来查看整个行。如果它找到“专业”一词，请将其复制到接下来的三个单元格中。 它这样做很好，但是当它循环时，当然下一个单元具有“专业”，它只是复制它。我需要弄清楚怎么说，如果你找到“专业”并复制它，跳过4个单元格并重新开始搜索.....尝试偏移活动单元格但不起作用。 任何想法？ 谢谢！

Sub CopySpecialtyOver() 

Dim rngRow As Range 
Dim Cell As Range 

Set rngRow = Range("A8:BA8") 

For Each Cell In rngRow 
    If InStr(1, Cell.Value, "Specialty") Then 
    Cell.Offset(0, 1).Value = Cell.Value 
    Cell.Offset(0, 2).Value = Cell.Value 
    Cell.Offset(0, 3).Value = Cell.Value 

    End If 
Next Cell 
End Sub 

Answer 1

这里是如何循环向后以你当前的代码：

Sub CopySpecialtyOver() 

    Dim rngRow As Range 
    Dim Cell As Range 
    Dim cIndex As Long 

    Set rngRow = Range("A8:BA8") 

    For cIndex = rngRow.Columns.Count To rngRow.Column Step -1 
     Set Cell = Cells(rngRow.Row, cIndex) 
     If InStr(1, Cell.Value, "Specialty", vbTextCompare) Then 
      Cell.Offset(, 1).Resize(, 3).Value = Cell.Value 
     End If 
    Next cIndex 

End Sub 

Answer 2

您可以通过一个迭代的整数替换“对于每个”：

Sub CopySpecialtyOver() 
    Dim i As Integer 
    Dim rngRow As Range 
    Dim Cell As Range 

    Set rngRow = Range("A8:BA8") 

    For i = 1 To rngRow.Cells.Count 
     Set Cell = rngRow(1, i) 
     If InStr(1, Cell.Value, "Specialty") Then 
      Cell.Offset(0, 1).Value = Cell.Value 
      Cell.Offset(0, 2).Value = Cell.Value 
      Cell.Offset(0, 3).Value = Cell.Value 
      i = i + 3 
     End If 
    Next i 
End Sub 

Answer 3

太谢谢你了！我最终解决这样的：

Sub CopySpecialtyOver() 

Dim rngRow As Range 
Dim Cell As Range 

Set rngRow = Range("A8:BA8") 

For Each Cell In rngRow 
If InStr(1, Cell.Value, "Specialty") Then 
    If InStr(1, Cell.Offset(0, -1).Value, "Specialty") Then 
    Else 
     Cell.Offset(0, 1).Value = Cell.Value 
     Cell.Offset(0, 2).Value = Cell.Value 
     Cell.Offset(0, 3).Value = Cell.Value 
     End If 
End If 
Next Cell 
End Sub 

Answer 4

For Each - 由其他应答指出 - 可能不是最好的策略。不过 - 你自找的 - 这里来使用一些在闭环控制来克服For Each的deficites在这个用例的一段代码：

Sub CopySpecialtyOver() 

Dim rngRow As Range 
Dim Cell As Range 
Dim Found As Boolean 
Dim Cnt As Integer 

Set rngRow = Range("A8:BA8") 
Found = False 
Cnt = 0 

For Each Cell In rngRow.Cells 

    If InStr(1, Cell.Value, "Specialty") And Not Found Then 
     ' capture start of sequence - otherwise do nothing 
     Found = True 
     Cnt = 0 
    Else 

     If Found Then 
      'if in Found mode increment counter 
      Cnt = Cnt + 1 

      ' expand using negative offset 
      If Cnt <= 3 Then 
       Cell = Cell.Offset(0, -Cnt).Value 
      End If 

      ' break after 3rd 
      If Cnt = 3 Then 
       Found = False 
       Cnt = 0 
      End If 

     End If 

    End If 

Next Cell 
End Sub 

这个看似更复杂的代码都会有其优势，当垂直运行（而非水平）超过不仅仅是一个细胞的福得多，因为For/Each执行大大优于普通For/Next