msgbox以特定格式请求用户输入 [英] msgbox asking for user input in specific format

问题描述

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

  Option Explicit 
子更新表（）
 
 Dim vReply As String 
 vReply = InputBox（Enter period（format：Q4 2010）to update，or hit enter to escape）
如果vReply = vbNullString然后退出Sub 
 
表格（Sheet1）。激活
 ActiveSheet.Range（B14）。Value = vReply 
 End Sub 
  

我也想知道是否有一些方法可以包括一个检查，以确保用户输入是正确的格式，如果没有，标记一个错误，并要求用户重新 -

非常感谢：

解决方案

这个，你非常接近（而不是 Inputbox ，你只需要在写入Sheet1 B14时使用 vReply p>

已更新修改为de-hmmm：

1. 使用 Application.InputBox 而不是InputBox作为它s为编码器提供了更多的可选性。但是很高兴在这种情况下而不是critcal


2. 使用正则表达式来确保字符串的形式是Q [1-4]，其中一年的范围是2010-2020年更新到2011-2013使用^ Q [1-4] \s20 [11-13] {2} $。q测试不区分大小写


3. 我已经将默认条目Q1 2011添加到使用currentd ate计算的提示中， Int（（Month（Now（）） - 1 ）/ 3）+ 1&& Year（Now（））返回Q4 2011。如果需要，您可以删除此提示


4. A do 循环用于测试无效字符串，如果提供的字符串与 strTitle 变量Please retry用于让用户知道先前的尝试无效（msg不会在用户未出错时首次显示）



5. 按取消触发a单独的退出消息让用户知道代码已经终止了

     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 
   如果strReply& vbNullString然后strTitle =请重试
    strReply = Application.InputBox（输入周期（格式：Q4 2010）更新，或按Enter键退出，strTitle，Q& Int（（Month （）） -  1）/ 3）+ 1&& Year（Now（）），，，，，2）
   如果strReply =False然后
    MsgBox ，退出代码，vbCritical 
   退出子
   结束如果
   循环直到.test（strReply）
   结束
   表（Sheet1）[b14]。 Value = UCase $（strReply）
    End Sub 
     

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:

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 :)

解决方案

something like this, you were very close (rather than Inputbox you just needed to use vReply when writing to Sheet1 B14)

Updated Overhauled to de-hmmm:

1. Uses Application.InputBox rather 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 Do loop is used to test invalid strings, if an invalid string is supplied than the strTitle variable 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
   

这篇关于msgbox以特定格式请求用户输入的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！