vba msgbox 要求用户输入特定格式

msgbox asking for user input in specific format

提问by heavyarms

I'm trying to write a quick little macro that asks the user for an input, and then copies this to a specific cell (B14 in Sheet1). Here's what I've got so far:

我正在尝试编写一个快速的小宏，要求用户输入，然后将其复制到特定单元格（Sheet1 中的 B14）。这是我到目前为止所得到的：

Option Explicit    
Sub updatesheet()

Dim vReply As String     
vReply = InputBox("Enter period (format: Q4 2010) to update, or hit enter to escape")
If vReply = vbNullString Then Exit Sub

Sheets("Sheet1").Activate
ActiveSheet.Range("B14").Value = vReply    
End Sub

I was also wondering if there is some way I can include a check to make sure the user input is in the correct format, and if not, flags up an error and asks the user to re-enter?

我还想知道是否有某种方法可以包含检查以确保用户输入的格式正确，如果没有，则标记错误并要求用户重新输入？

Help greatly appreciated :)

非常感谢帮助:)

回答by Tony Dallimore

I have difficulties with both the earlier answers.

我对前面的两个答案都有困难。

I agree that validation is essential; the user might type "2011-4" if they do not think hard enough about the prompt. Checking that its format is "Q# ####" is definitely a step in the right direction. However:

我同意验证是必不可少的；如果用户对提示不够认真，他们可能会输入“2011-4”。检查其格式是否为“Q#####”绝对是朝着正确方向迈出的一步。然而：

I would have pointed out that this level of checking is not enough. "Q5 1234", for example, would match this format. "Q5 1234" would suggest the user was trying to break the system but "Q4 2101" is an easy error to make.

我会指出这种级别的检查是不够的。例如，“Q5 1234”将匹配此格式。“Q5 1234”会暗示用户试图破坏系统，但“Q4 2101”是一个容易犯的错误。

The Like operator is your only choice with Excel 2003 but with later versions I would recommend considering regular expressions. I have been trying them out with VB 2010. I do not deny they are a struggle to understand but they do so much for you. Perhaps heavyarms has enough learning on his plate at the moment but I would still suggest looking at some of the recent questions about their use.

Like 运算符是 Excel 2003 的唯一选择，但在更高版本中，我建议考虑使用正则表达式。我一直在用 VB 2010 尝试它们。我不否认它们很难理解，但它们为您做了很多。或许，heavyarms 目前有足够的学习经验，但我仍然建议查看最近有关它们使用的一些问题。

As used in the earlier answers, InputBox does not achieve heavyarms' objective. If I typed "Q4 2101" instead of "Q4 2011" and the macro was enhanced to check for impossible dates, I would not know of my simple error unless the error message included the value I typed. Also I could not edit "Q4 2101" to the value I meant to type. The syntax for InputBox is vReply = InputBox(Prompt, Title, Default, ...). So if I was going to recommend the use of the Like operator, I would suggest:

正如在前面的答案中使用的那样， InputBox 没有实现重武器的目标。如果我输入“Q4 2101”而不是“Q4 2011”并且宏被增强以检查不可能的日期，除非错误消息包含我输入的值，否则我不会知道我的简单错误。此外，我无法将“Q4 2101”编辑为我想要输入的值。InputBox 的语法是 vReply = InputBox(Prompt, Title, Default, ...)。因此，如果我要推荐使用 Like 运算符，我会建议：

Sub updatesheet()

  Dim vReply As String
  Dim Prompt As String
  Dim Title As String
  Dim UpdateQuarter As Integer
  Dim UpdateYear As Integer

  ' I have found users respond better to something like "Qn ccyy" 
  Prompt = "Enter period (format: Qn ccyy) to update, or hit enter to escape"
  ' I find a title that gives context can be helpful.
  Title = "Update sheet"

  vReply = InputBox(Prompt, Title)

  Do While True
    ' I have had too many users add a space at the end of beginning of a string
    ' or an extra space in the middle not to fix these errors for them.
    ' Particularly as spotting extra spaces can be very difficult. 
    vReply = UCase(Trim(VReply))
    vReply = Replace(vReply, "  ", " ") ' Does not cater for three spaces 
    If Len(vReply) = 0 Then Exit Sub
    If vReply Like "Q# ####" Then
      ' I assume your macro will need these value so get them now
      ' so you can check them.
      UpdateQuarter = Mid(vReply, 2, 1)
      UpdateYear = Mid(vReply, 4)
      ' The check here is still not as full as I would include in a macro
      ' released for general use.  I assume "Q4-2011" is not valid because
      ' the quarter is not finished yet.  Is "Q3-2011" available yet?  I
      ' would use today's date to calculate the latest possible quarter.
      ' I know "You cannot make software foolproof because fools are so
      ' ingenious" but I have learnt the hard way that you must try.
      If UpdateQuarter >= 1 And UpdateQuarter <= 4 And _
         UpdateYear >= 2009 And UpdateYear <= 2012 Then
        Exit Do
      Else
        ' Use MsgBox to output error message or include it in Prompt
      End If
    Else
      ' Use MsgBox to output error message or include it in Prompt
    End If
    vReply = InputBox(Prompt, Title, vReply)
  Loop

End Sub

Lastly, I rarely use InputBox because Forms, once mastered, are so easy to create and offer far more control.

最后，我很少使用 InputBox，因为一旦掌握了表单，就非常容易创建并提供更多控制。

回答by brettdj

something like this, you were very close (rather than Inputboxyou just needed to use vReplywhen writing to Sheet1 B14)

像这样的东西，你非常接近（而不是Inputbox你只需要vReply在写入 Sheet1 B14 时使用）

UpdatedOverhauled to de-hmmm:

更新大修到 de-hmmm：

1. Uses Application.InputBoxrather than 'InputBox' as this provides the coder with more optionality. But nice to have in this instance rather than critcal
2. Uses a Regex to ensure that the string is of the form "Q[1-4]" with a year ranging from 2010-2020 (to update to 2011-2013 use "^Q[1-4]\s20[11-13]{2}$". The "q" test is case insensitive
3. I've added a default entry of "Q1 2011" to the prompt that calcuates using the currentd ate, Int((Month(Now()) - 1) / 3) + 1 & " " & Year(Now())returns Q4 2011 . You can remove this prompt if desired
4. A Doloop is used to test invalid strings, if an invalid string is supplied than the strTitlevariable of "Please retry"" is used to let the user know that prior attempts were invalid (the msg doesn't show the first time through as the user is yet to make a mistake)

5. Pressing Cancel triggers a separate exit message to let the user know the code has terminated early

    Option Explicit
   Sub Rattle_and_hmmmm()
   Dim strReply As String
   Dim strTitle As String
   Dim objRegex As Object
   Set objRegex = CreateObject("vbscript.regexp")
   With objRegex
       .ignorecase = True
       .Pattern = "^Q[1-4]\s20[10-20]{2}$"
       Do
           If strReply <> vbNullString Then strTitle = "Please retry"
           strReply = Application.InputBox("Enter period (format: Q4 2010) to update, or hit enter to escape", strTitle, "Q" & Int((Month(Now()) - 1) / 3) + 1 & " " & Year(Now()), , , , , 2)
           If strReply = "False" Then
               MsgBox "User hit cancel, exiting code", vbCritical
               Exit Sub
           End If
       Loop Until .test(strReply)
   End With
   Sheets("Sheet1").[b14].Value = UCase$(strReply)
   End Sub
   

1. 使用Application.InputBox而不是“InputBox”，因为这为编码器提供了更多的选择。但很高兴在这种情况下而不是关键
2. 使用正则表达式来确保字符串的格式为“Q[1-4]”，年份范围为 2010-2020（更新到 2011-2013 使用"^Q[1-4]\s20[11-13]{2}$"。“q”测试不区分大小写
3. 我在使用当前日期计算的提示中添加了一个默认条目“Q1 2011”，Int((Month(Now()) - 1) / 3) + 1 & " " & Year(Now())返回 Q4 2011 。如果需要，您可以删除此提示
4. 甲Do环是用来测试无效的字符串，如果无效字符串比所提供的strTitle“请重试””用于让用户知道之前的尝试无效（味精不显示在第一时间通过作为用户的可变还没有犯错）

5. 按取消触发单独的退出消息，让用户知道代码已提前终止

    Option Explicit
   Sub Rattle_and_hmmmm()
   Dim strReply As String
   Dim strTitle As String
   Dim objRegex As Object
   Set objRegex = CreateObject("vbscript.regexp")
   With objRegex
       .ignorecase = True
       .Pattern = "^Q[1-4]\s20[10-20]{2}$"
       Do
           If strReply <> vbNullString Then strTitle = "Please retry"
           strReply = Application.InputBox("Enter period (format: Q4 2010) to update, or hit enter to escape", strTitle, "Q" & Int((Month(Now()) - 1) / 3) + 1 & " " & Year(Now()), , , , , 2)
           If strReply = "False" Then
               MsgBox "User hit cancel, exiting code", vbCritical
               Exit Sub
           End If
       Loop Until .test(strReply)
   End With
   Sheets("Sheet1").[b14].Value = UCase$(strReply)
   End Sub
   

回答by Patrick Honorez

Sub updatesheet()
    Dim vReply As String
    Do
        'edit: added UCase on INputBox
        vReply = UCase(InputBox("Enter period (format: Q4 2010) to update, or hit enter to escape"))
    Loop Until Len(vReply) = 0 Or vReply Like "Q# ####"
    If vReply = vbNullString Then Exit Sub
    'continue...
End Sub