vba 输入框一直做直到输入两个字母

Inputbox do until two letters are entered

提问by Zachary Smith

This is my first time working with an InputBox. The desire is to have the user insert their initials for entry into a spreadsheet that will be imported into a database. I'm using the InputBox to promote consistency and AutoFill the necessary cells.

这是我第一次使用 InputBox。期望是让用户插入他们的姓名首字母以输入到将被导入到数据库中的电子表格中。我正在使用 InputBox 来提高一致性并自动填充必要的单元格。

I am having trouble understanding a process whereby a user enters information, if the entry is two letters its accepted and populated into the cells, else a message appears indicating two letters are required and the InputBox displays again. Through testing I believe my loop is not working as I would expect. If the first entry is two letters it populates information into excel as expected. If, however, the first entry is incorrect and a subsequent entry is correct it does not seem to exit the loop. I'm not sure why this would be? Any help would be greatly appreciated.

我无法理解用户输入信息的过程，如果输入的是两个字母，它被接受并填充到单元格中，否则会出现一条消息，指示需要两个字母，并且 InputBox 再次显示。通过测试，我相信我的循环没有按预期工作。如果第一个条目是两个字母，它会按预期将信息填充到 excel 中。但是，如果第一个条目不正确而后续条目正确，则似乎不会退出循环。我不确定为什么会这样？任何帮助将不胜感激。

Dim c As Range

Set c = Sheets("CompilePriceAdjustments").Range("E2")

    c = InputBox("Please Enter Initials", "PRICE INCREASE APPROVER")
Do Until c = vbString And Len(c) = 2
    MsgBox ("You must enter two letters")
    c = InputBox("Please Enter Initials", "PRICE INCREASE APPROVER")
Loop

Sheets("CompilePriceAdjustments").Range("E2").Value = UCase(c)
c.AutoFill Destination:=Sheets("CompilePriceAdjustments").Range("E2:E" & Cells    (Rows.Count, "D").End(xlUp).Row)

回答by Siddharth Rout

I think this is what you are trying?

我认为这就是你正在尝试的？

Sub Sample()
    Dim c As Range
    Dim Ret

    Set c = Sheets("CompilePriceAdjustments").Range("E2")

    Ret = InputBox("Please Enter Initials - (Only alphabets allowed of 2 Length)", "PRICE INCREASE APPROVER")

    Do Until (isString(Ret) And Len(Ret) = 2)
        Ret = InputBox("Please Enter Initials - (Only alphabets allowed of 2 Length)", "PRICE INCREASE APPROVER")
    Loop

    c.Value = UCase(Ret)
    '
    '~~> Rest of the code
    '
End Sub

Function isString(s As Variant) As Boolean
    Dim i As Long

    isString = True

    For i = 1 To Len(s)
        Select Case Asc(Mid(s, i, 1))
        Case 65 To 90, 97 To 122
        Case Else
            isString = False
            Exit Function
        End Select
    Next i
End Function

EDIT

编辑

I see one flaw in your approach. What if the user wants to cancel and exit? You might want to consider this code?

我发现你的方法有一个缺陷。如果用户想取消退出怎么办？你可能想考虑这个代码？

Sub Sample()
    Dim c As Range
    Dim Ret

    Set c = Sheets("CompilePriceAdjustments").Range("E2")

    Ret = InputBox("Please Enter Initials-(Only alphabets allowed of 2 Length)", _
          "PRICE INCREASE APPROVER")

    '~~> Added  Or Ret = "" so that user can cancel the inputbox if required
    Do Until (isString(Ret) And Len(Ret) = 2) Or Ret = ""
        Ret = InputBox("Please Enter Initials-(Only alphabets allowed of 2 Length)", _
        "PRICE INCREASE APPROVER")
    Loop

    '~~> This is required so that user can press cancel and exit
    If Ret = "" Then Exit Sub

    c.Value = UCase(Ret)
    '
    '~~> Rest of the code
    '
End Sub

Function isString(s As Variant) As Boolean
    Dim i As Long

    isString = True

    For i = 1 To Len(s)
        Select Case Asc(Mid(s, i, 1))
        Case 65 To 90, 97 To 122
        Case Else
            isString = False
            Exit Function
        End Select
    Next i
End Function

回答by Gary's Student

Consider:

考虑：

Sub dural()
    Dim c As Range, init As String
    Set c = Sheets("CompilePriceAdjustments").Range("E2")
    init = ""
    While Len(init) <> 2
        init = Application.InputBox(Prompt:="Enter two initials", Type:=2)
    Wend
    MsgBox "Thanks"
    c.Value = init
End Sub