Question

所以我试着写一个For Each循环来查看整行。如果它找到了单词＆＃34; Specialty＆＃34;将其复制到下三个单元格。这部分很好，但是当它循环时，当然下一个单元格具有＆＃34; Specialty＆＃34;在它bc它只是复制了它。我需要弄清楚怎么说，如果你找到了＆＃34;专业＆＃34;并将其复制过来，将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

您可以用可迭代的整数替换'For each'：

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的缺陷：

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表现更好

使用For / Each循环但跳过活动单元VBA

4 个答案: