msgbox запрашивает ввод пользователя в определенном формате

Question

Я пытаюсь написать быстрый маленький макрос, который запрашивает у пользователя ввод, а затем копирует его в определенную ячейку (B14 на листе 1). Вот что у меня так далеко:

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, потому что формы, освоенные, очень просты в создании и предлагают гораздо больший контроль.

Answer 2

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

Answer 3

как-то так, вы были очень близки (вместо Inputbox вам просто нужно было использовать vReply при записи в Sheet1 B14)

Обновлено Переработано на de-hmmm:

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