Question

我已将此子作为更大代码的一部分编写。实际上我要做的就是从C列开始，复制有值的地方，直到我点击“结束”并粘贴“L1”。如果单元格中没有值，我不希望循环结束，因为会有间隙。当我尝试运行代码时，它会在没有退出的情况下卡在循环中。

Sub LoopEmailAdd()

Dim i As Long

i = 1

Do While Cells(1, "C").Value = "Email"
    If Cells(1 + i, "C").Value <> Empty And Cells(1 + i, "C").Value <> "End" Then
        Cells(1 + i, "C").Copy _
        Destination:=Range("L1")
        i = i + 1
    ElseIf Cells(1 + i, "C").Value = "End" Then
        Exit Do
    End If
Loop

End Sub

Answer 1

根据您的描述，您可以松开循环并使用Find代替，请尝试下面的代码：

Option Explicit

Sub LoopEmailAdd()

Dim FindRng As Range

Set FindRng = Columns(3).Find("End")

' make sure Find was successful finding "End"
If Not FindRng Is Nothing Then
    Cells(FindRng.Row - 1, "C").Copy Range("L1")
Else ' in case Find failed
    MsgBox "Unable to find End in column C", vbCritical
End If

End Sub

退出Do While循环

1 个答案: