Question

我正在尝试编写一个快速的小宏，询问用户输入，然后将其复制到特定的单元格（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

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

非常感谢帮助：）

Answer 1

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

我同意验证是必不可少的;如果他们对提示的思考不够，用户可能会输入“2011-4”。检查其格式是“Q＃####”，这绝对是朝着正确方向迈出的一步。但是：

我会指出这种程度的检查是不够的。例如，“Q5 1234”将匹配此格式。 “Q5 1234”会建议用户试图打破系统，但“Q4 2101”很容易出错。

Like运算符是Excel 2003的唯一选择，但对于更高版本，我建议考虑使用正则表达式。我一直在尝试使用VB 2010.我不否认他们很难理解，但他们为你做了很多。也许重型武器目前在他的盘子上有足够的学习，但我仍然建议查看最近有关其使用的一些问题。

如前面的答案中所使用的，InputBox没有实现重型目标。如果我键入“Q4 2101”而不是“Q4 2011”并且宏被增强以检查不可能的日期，除非错误消息包含我输入的值，否则我不会知道我的简单错误。另外，我无法将“Q4 2101”编辑为我打算键入的值。 InputBox的语法是vReply = InputBox（提示，标题，默认，...）。因此，如果我打算推荐使用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

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

Answer 2

类似这样的事情，你非常接近（而不是Inputbox，你只需要在写入Sheet1 B14时使用vReply

已更新已彻底改编为de-hmmm：

使用Application.InputBox而不是'InputBox'，因为这为编码器提供了更多选项。但很高兴在这个例子而不是批评
使用正则表达式确保字符串的格式为“Q [1-4]”，年份范围为2010-2020（更新至2011-2013使用"^Q[1-4]\s20[11-13]{2}$"。“q”测试不区分大小写
我已将“Q1 2011”的默认条目添加到使用当前ate计算的提示中，Int((Month(Now()) - 1) / 3) + 1 & " " & Year(Now())将返回2011年第4季度。如果需要，您可以删除此提示
Do循环用于测试无效字符串，如果提供的字符串无效，则“{retry”“strTitle变量用于让用户知道先前的尝试无效（因为用户还没有犯错，所以msg没有显示第一次）

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

 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

Answer 3

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

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

3 个答案: