VBA循环无法正常工作

时间:2014-08-20 19:13:24

标签: excel vba loops

我是编写VBA的新手,并不确定要完成此循环。我正在读下一列并确定细胞颜色。如果单元格颜色正确,那么我预先形成动作。问题是该操作将该信息粘贴到单元格N7中。这就是我的循环搞砸了,因为我需要它接下来的单元格A9。有人可以解释下一步会是什么。我知道需要把那个单元格A8放在一个循环中,每次增加1但不知道该怎么做。

Range("A8").Select

    Do
        If ActiveCell.Interior.Color = RGB(79, 129, 189) Then
            ActiveCell.Offset(1, 0).Select
            Selection.End(xlDown).Select
            ActiveCell.Offset(-1, 0).Select
            Range(Selection, Selection.End(xlUp).Offset(1, 0)).Select
            Selection.Copy
            Range("N7").Select
            ActiveSheet.Paste

        ElseIf ActiveCell.Select = "BREAK" Then
            Exit Sub

        Else
            ActiveCell.Offset(1, 0).Select
        End If

    Loop

End Sub

1 个答案:

答案 0 :(得分:1)

编辑:更新了下面的脚本,以便根据其他评论复制数据

.Select.Activate是运行时错误的常见来源,在这种情况下可能会被避免。虽然我在你确定A列中的颜色时想要采取的行动并不是很清楚,但你可以使用以下评论很多的脚本来完成“循环并检查BREAK”动作。

Option Explicit
Sub ProcessColumnA()

Dim Counter As Long
Dim MySheet As Worksheet
Dim Cell As Range, DestCell As Range

'set references up-front
Counter = 8
Set MySheet = ThisWorkbook.ActiveSheet
Set Cell = MySheet.Cells(Counter, 1)
Set DestCell = MySheet.Cells(7, 14)

'loop on column A until we find "BREAK" or
'counter is greater than 10K, whichever comes first
Do Until Cell.Value = "BREAK" Or Counter > 10000

    'check color and take action if necessary
    If Cell.Interior.Color = RGB(79, 129, 189) Then

        'do the copy work here
        Cell.Copy Destination:=DestCell

        'increment the destination cell
        Set DestCell = DestCell.Offset(1, 0)

    End If

    'increment the counter variable and set the next cell
    Counter = Counter + 1
    Set Cell = MySheet.Cells(Counter, 1)

Loop

'send user a message regarding the results
If Counter > 10000 Then
    MsgBox ("Whoa you hit 10K cells before finding 'BREAK'...")
Else
    MsgBox ("Processing complete!")
End If

End Sub