Блог

Главная - Вопросы по программированию - Использование массива в поле ввода

Использование массива в поле ввода

#excel #vba

Вопрос:

Я хочу создать небольшую функцию поля ввода, в которой вводом пользователя могут быть только месяцы года (январь, февраль, март и т. Д.), Я решил, что это можно сделать с помощью переменной variant ( months ). Однако я получаю ошибку несоответствия типов, возможно ли то , чего я пытаюсь достичь? Спасибо.

 Sub test()

Dim NewName As Variant, Months As Variant
Months = Split("January,February,March,April,May,June,July,August,September,October,November,December")

Re_Enter_NewName:
NewName = InputBox("Please Write Month- Case Sensitive", "MONTH", vbOKCancel)

For Each Months In NewName ''Type Mismatch
If NewName = Months Then
Exit Sub

ElseIf NewName <> Months Then
 MsgBox "Please Enter a Month of the Year"
 GoTo Re_Enter_NewName:
Else
End If

Next Months

End Sub

Ответ №1:

Я бы использовал две функции:

Одна функция для создания массива с действительными месяцами — пожалуйста, проверьте код ниже: вы должны использовать массив без разделения. В качестве альтернативы вы можете прочитать действительные названия месяцев из рабочего листа или автоматически создать список и т. Д.

Одна универсальная функция для проверки, находится ли значение в массиве

 Option Explicit

Sub testGetMonthsName()

Dim MonthSelected As Variant, arrMonths As Variant
arrMonths = getMonthArray

Re_Enter_NewName:
MonthSelected = InputBox("Please Write Month- Case Sensitive", "MONTH")

If MonthSelected = vbNullString Then
    'cancel or empty
    Exit Sub

ElseIf isValueInArray(MonthSelected, arrMonths) Then
    'MonthSelected is valid
    Exit Sub
    
Else
    'MonthSelected is not valid
    MsgBox "Please Enter a Month of the Year"
    GoTo Re_Enter_NewName:
End If

End Sub


Private Function getMonthArray() As Variant
getMonthArray = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
End Function

Private Function isValueInArray(value As Variant, arrValues As Variant) As Boolean
Dim i As Long
For i = LBound(arrValues) To UBound(arrValues)
    If arrValues(i) = value Then
        isValueInArray = True
        Exit For
    End If
Next
End Function

На основе комментария от @ChristanBuse — более продвинутая версия:

 Option Explicit

Sub test_getMonthFromUser()

Dim strMonth As String, cancel As Boolean

Do
    strMonth = getMonthNameFromUser(cancel)
    If cancel = True Then Exit Sub
    
    If isMonthNameValid(strMonth) = False Then
        If MsgBox("Please enter a valid month name", vbOKCancel   vbExclamation) = vbCancel Then
            Exit Do
        Else
            strMonth = vbNullString
        End If
    End If
Loop Until LenB(strMonth) > 0

If LenB(strMonth) > 0 Then
    MsgBox "Valid month selected: " amp; strMonth
End If

End Sub

Private Function getMonthNameFromUser(ByRef cancel As Boolean) As String

Dim strMonth As String
strMonth = InputBox("Please Write Month- Case Sensitive", "MONTH")

If StrPtr(strMonth) = 0 Then
    cancel = True
    Exit Function
End If

getMonthNameFromUser = strMonth

End Function


Private Function isMonthNameValid(strMonth As String) As Boolean
'will check according to systems language
'e.g. in German: Januar - in English: January
Dim i As Long
For i = 1 To 12
    If MonthName(i) = strMonth Then
        isMonthNameValid = True
        Exit For
    End If
Next
End Function

Комментарии:

1. Я бы добавил проверку отмены If StrPtr(MonthSelected)= 0 Then Exit Sub и оставил пустой регистр как часть логики повторного ввода. Лучше использовать Do... Loop Until... петлю и снять GoTo полностью. Очиститель. Для остальных 1

2. О, и, возможно, используйте коллекцию вместо массива месяцев, тогда isValueInArray это не понадобится, так как вы можете проверить, существует ли элемент по ключу

3. @CristianBuse: вы правы — есть еще кое-что для рефакторинга (например, я бы, по крайней мере, автоматически создал массив/коллекцию месяцев) — но я не уверен, что коллекция или массив «лучше» — я думаю, что это скорее индивидуальные предпочтения.

4. @CristianBuse добавил вторую, переработанную версию

Ответ №2:

Вы также должны справиться с ситуацией, когда пользователь отменяет поле ввода, чтобы предотвратить бесконечную работу

 Sub test()
  Dim NewName As Variant, Months As Variant, mname, UserMonth
  UserMonth = ""
  'Months = Split("January,February,March,April,May,June,July,August,September,October,November,December")
  'Months is Variant/String array (1 element)
  'be sure to specify delimiter (comma)
  Months = Split( _
    "January,February,March,April,May,June,July,August,September,October,November,December", _
    ",")
    'Months is Variant/String array (12 elements)
Re_Enter_NewName:
  NewName = InputBox("Please Write Month- Case Sensitive", "MONTH", vbOKCancel)
  
  'For Each Months In NewName 'Type Mismatch: for each array in string
  For Each mname In Months
    If NewName = mname Then
      UserMonth = mname
    End If
  Next mname
  If UserMonth = "" Then
    MsgBox "Please Enter a Month of the Year"
     GoTo Re_Enter_NewName:
  End If
End Sub
Метки: