VBA中的Do Until循环不会在Exit Sub上中断

时间:2015-05-06 09:52:17

标签: vba excel-vba excel

我写了以下代码以请求输入。

validInput = False
Do
    str = InputBox("Some text...")
    If str = vbNullString Then
        MsgBox ("Input canceled")
        Exit Sub
    Else
        If IsNumeric(str) Then
            exchange = CCur(str)
            validInput = True
        Else
            MsgBox ("Input invalid.")
        End If
    End If
Loop Until validInput

但是,如果我取消输入,它会一直询问我输入,即使我添加了Exit Sub行,循环也会继续。

我尝试在validInput = True之前添加Exit Sub,但这也不起作用。

我错过了什么?

修改 这是整个子。

Public Sub CurrencyCheck()

Dim ws As Worksheet
Set ws = ActiveWorkbook.Worksheets("Datenbank")
Dim lastRow As Long
lastRow = ws.Cells(Rows.Count, 4).End(xlUp).Row
Dim i As Long
Dim j As Long
Dim curSymbol As String
Dim exchange As Currency
Dim str As String
Dim curArr() As String
Dim arrCnt As Integer
arrCnt = 1
Dim curInArr As Boolean
curInArr = False
Dim curIndex As Integer
Dim validInput As Boolean

ReDim curArr(1 To 2, 1 To arrCnt)

For i = 1 To lastRow
    If ws.Cells(i, 4).Value <> "Price" And ws.Cells(i, 4).Value <> "" Then
        curSymbol = Get_Currency(ws.Cells(i, 4).text) 'Function that returns currency symbol (€) or abbreviation (EUR)
        If curSymbol <> "€" Then
            For j = LBound(curArr, 2) To UBound(curArr, 2)
                If curArr(1, j) = curSymbol Then
                    curInArr = True
                    curIndex = j
                End If
            Next j
            If Not curInArr Then
                If curSymbol = "EUR" Then
                    ReDim Preserve curArr(1 To 2, 1 To arrCnt)
                    curArr(1, arrCnt) = curSymbol
                    curArr(2, arrCnt) = 1
                    curIndex = arrCnt
                    arrCnt = arrCnt + 1
                Else
                    validInput = False
                    Do Until validInput
                        str = InputBox("Some text...")
                        If str = vbNullString Then
                            MsgBox ("Input canceled.")
                            Exit Sub
                        Else
                            If IsNumeric(str) Then
                                exchange = CCur(str)
                                validInput = True
                            Else
                                MsgBox ("Input invalid.")
                            End If
                        End If
                    Loop
                    ReDim Preserve curArr(1 To 2, 1 To arrCnt)
                    curArr(1, arrCnt) = curSymbol
                    curArr(2, arrCnt) = exchange
                    curIndex = arrCnt
                    arrCnt = arrCnt + 1
                End If
            End If
            ws.Cells(i, 4).Value = StringToCurrency(ws.Cells(i, 4).text)
            ws.Cells(i, 4).Value = ws.Cells(i, 4).Value * curArr(2, curIndex)
            ws.Cells(i, 4).NumberFormat = "#,##0.00 €"
        End If
    End If
Next i

End Sub

EDIT2:当我将输入循环作为子程序运行时,它可以工作。宏在另一个工作簿中运行,这样做就失败了......

EDIT3:我的不好。问题与代码无关,而与子程序的定位无关。它被称为重复,因为它被循环调用。我要道歉。谢谢大家。

2 个答案:

答案 0 :(得分:0)

我认为这不是一个空字符串。试试这个

getSupportActionBar

答案 1 :(得分:0)

这将循环,直到输入数字:

Sub dural()
    Dim validInput As Boolean
    Dim strg As String, x As Variant
    validInput = False
    Do
        strg = Application.InputBox(Prompt:="enter value", Type:=2)
        If strg = "False" Then
        ElseIf IsNumeric(strg) Then
            x = CCur(strg)
            validInput = True
        End If
    Loop Until validInput
End Sub

修改#1:

如果用户触摸 CANCEL 按钮或红色 x 按钮,此版本将退出循环:

Sub dural()
    Dim validInput As Boolean
    Dim strg As String, x As Variant
    validInput = False
    Do
        strg = Application.InputBox(Prompt:="enter value", Type:=2)
        If strg = "False" Or strg = "" Then
            validInput = True
        ElseIf IsNumeric(strg) Then
            x = CCur(strg)
            validInput = True
        End If
    Loop Until validInput
End Sub