使用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