即使有多个条件满足一个条件后循环停止

Question

下面的代码在满足一次条件后会"exit for"，即使范围内有更多的满足条件。我该如何纠正？

Private Sub cmdAdd_Click()
    On Error GoTo Whoa
    Dim LastRow As Long, i As Long
    LastRow = ActiveSheet.Range(Me.txtTaskCol.Value & Rows.Count).End(xlUp).Row
    'Copy input values to sheet
    For i = 1 To LastRow
        If UCase(CStr(ActiveSheet.Range(Me.txtTaskCol.Value & i).Value)) = UCase(CStr(Me.txtTask.Value)) Then
            ActiveSheet.Range(Me.txtUnitCol.Value & i).Value = Me.txtQuantity.Value
            Exit For
        Else
            If i = LastRow Then MsgBox "Task Not Found!"
        End If
    Next i
    'Clear input controls
    Me.txtTask.Value = ""
    Me.txtQuantity.Value = ""
    Exit Sub

Whoa:
        Select Case Err.Number
            Case 1004
                MsgBox "Check for Valid Column Letters!"
        End Select

End Sub

Answer 1

回应 K.Davis 评论，不确定为什么要退出？

我对您的代码进行了一些修改。不包括错误处理，但代码应该完成循环并告诉您是否未找到任何内容。

Private Sub cmdAdd_Click()
    On Error GoTo Whoa
    Dim LastRow As Long, i As Long
    LastRow = ActiveSheet.Range(Me.txtTaskCol.Value & Rows.Count).End(xlUp).Row

'Set a counter so you can message Task Not Found
    Dim matchCounter as Integer
    matchCounter = 0

'Copy input values to sheet
    For i = 1 To LastRow
        If UCase(CStr(ActiveSheet.Range(Me.txtTaskCol.Value & i).Value)) = _
        UCase(CStr(Me.txtTask.Value)) Then
            ActiveSheet.Range(Me.txtUnitCol.Value & i).Value = Me.txtQuantity.Value
            matchCounter = matchCounter + 1
        End If
    Next i

If matchCounter = 0 then MsgBox "Nothing Found"

'Clear input controls
    Me.txtTask.Value = ""
    Me.txtQuantity.Value = ""
    Exit Sub

End Sub

希望对您有所帮助。

Answer 2

如果您的 If...Then 语句一次为真，只需使用一个布尔标志，将标志设置为 True：

如果您希望在满足条件后继续您的 For...Next 语句，那么您不想退出。

Private Sub cmdAdd_Click()
    On Error GoTo Whoa
    Dim LastRow As Long, i As Long, tskFlg As Boolean
    LastRow = ActiveSheet.Range(Me.txtTaskCol.Value & Rows.Count).End(xlUp).Row
    'Copy input values to sheet
    For i = 1 To LastRow
        If UCase(CStr(ActiveSheet.Range(Me.txtTaskCol.Value & i).Value)) = UCase(CStr(Me.txtTask.Value)) Then
            ActiveSheet.Range(Me.txtUnitCol.Value & i).Value = Me.txtQuantity.Value
            tskFlg = True
        End If
    Next i
    If tskFlg = False Then MsgBox "Task Not Found!"
    'Clear input controls
    Me.txtTask.Value = ""
    Me.txtQuantity.Value = ""
    Exit Sub

Whoa:
        Select Case Err.Number
            Case 1004
                MsgBox "Check for Valid Column Letters!"
        End Select

End Sub

即使有多个条件满足一个条件后循环停止

Loop stops after one condition is met even if there are multiple

excel

vba

loops

exit-code