直到VBA循环循环不会破坏出口子



我编写了以下代码以要求输入。

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行。

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

我缺少什么?

编辑:这是整个子。

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:我的不好。该问题与代码无关,而与子例程的定位有关。它被称为一遍又一遍地,因为它被称为循环。我必须道歉。感谢所有人。

这将循环直到输入数字为止:

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:

如果用户触摸取消按钮或红色 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

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

If str = vbNullString or str = "" Then

最新更新