Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Центр помощи > [VB] Определить день недели


Автор: Hates 15.10.2008, 08:54
Разработать проек, который определяет по заданному числу месяца и по дню недели первого числа этого месяца день недели для заданного числа. 
(Пример: первое число - вторник, тогда 17 - четверг, задали число 17)

Проект нужно решить c помощью Select Case smile 

Автор: Akina 15.10.2008, 10:40
Цитата(Hates @  15.10.2008,  09:54 Найти цитируемый пост)
Проект нужно решить c помощью Select Case 

Даже представить не могу, куда тут его прицепить... ибо

(Номер дня недели) = ((Номер первого дня недели) + (Номер дня в месяце) - 1) MOD 7

Автор: kapbepucm 15.10.2008, 10:47
Код

Sub test()
  Dim CurrentDate As Byte
  Dim CurrentDay As byte
  Dim FirstDay As String
  On Error GoTo ErrorLabel
  Do
    CurrentDate = CByte(InputBox("Введте число месяца (от 1 до 31)", , "31"))
  Loop Until (CurrentDate > 0) And (CurrentDate < 32)
  On Error GoTo 0
  FirstDay = InputBox("Введите название первого дня недели этого месяца (понедельник, вторник, среда, четверг, пятница, суббота, воскресенье)", , "понедельник")
  Select Case FirstDay
  Case "понедельник": CurrentDay = (CurrentDate + 0) Mod 7
  Case "вторник": CurrentDay = (CurrentDate + 1) Mod 7
  Case "среда": CurrentDay = (CurrentDate + 2) Mod 7
  Case "четверг": CurrentDay = (CurrentDate + 3) Mod 7
  Case "пятница": CurrentDay = (CurrentDate + 4) Mod 7
  Case "суббота": CurrentDay = (CurrentDate + 5) Mod 7
  Case "воскресенье": CurrentDay = (CurrentDate + 6) Mod 7
  Case Else
    MsgBox "Неизвестный день недели " & FirstDay & " попробуйте набрать ещё раз из этого списка (понедельник, вторник, среда, четверг, пятница, суббота, воскресенье)", vbCritical
    GoTo ExitLabel
  End Select
  Select Case CurrentDay
  Case 0: MsgBox "воскресенье", , "Ответ"
  Case 1: MsgBox "понедельник", , "Ответ"
  Case 2: MsgBox "вторник", , "Ответ"
  Case 3: MsgBox "среда", , "Ответ"
  Case 4: MsgBox "четверг", , "Ответ"
  Case 5: MsgBox "пятница", , "Ответ"
  Case 6: MsgBox "суббота", , "Ответ"
  End Select
ExitLabel:
Exit Sub
ErrorLabel:
  If Err.Number = 13 Then Resume Else Resume ExitLabel
End Sub

Автор: Hates 16.10.2008, 16:56
Знаю точно что задание должно быть без циклов. smile 

Автор: Akina 16.10.2008, 17:24
А тут и нет циклов, за исключением цикла при вводе числа месяца - и то он там исключительно для защиты от дурака.

Автор: kapbepucm 17.10.2008, 08:43
Hates, Akina прав, но если вам действительно не надо "защиту от дурака", её можно удалить:
Код
Sub test()
  Dim CurrentDate As Byte
  Dim CurrentDay As byte
  Dim FirstDay As String
  CurrentDate = CByte(InputBox("Введте число месяца (от 1 до 31)", , "31"))
  FirstDay = InputBox("Введите название первого дня недели этого месяца (понедельник, вторник, среда, четверг, пятница, суббота, воскресенье)", , "понедельник")
  Select Case FirstDay
  Case "понедельник": CurrentDay = (CurrentDate + 0) Mod 7
  Case "вторник": CurrentDay = (CurrentDate + 1) Mod 7
  Case "среда": CurrentDay = (CurrentDate + 2) Mod 7
  Case "четверг": CurrentDay = (CurrentDate + 3) Mod 7
  Case "пятница": CurrentDay = (CurrentDate + 4) Mod 7
  Case "суббота": CurrentDay = (CurrentDate + 5) Mod 7
  Case "воскресенье": CurrentDay = (CurrentDate + 6) Mod 7
  Case Else
    MsgBox "Неизвестный день недели " & FirstDay & " попробуйте набрать ещё раз из этого списка (понедельник, вторник, среда, четверг, пятница, суббота, воскресенье)", vbCritical
    GoTo ExitLabel
  End Select
  Select Case CurrentDay
  Case 0: MsgBox "воскресенье", , "Ответ"
  Case 1: MsgBox "понедельник", , "Ответ"
  Case 2: MsgBox "вторник", , "Ответ"
  Case 3: MsgBox "среда", , "Ответ"
  Case 4: MsgBox "четверг", , "Ответ"
  Case 5: MsgBox "пятница", , "Ответ"
  Case 6: MsgBox "суббота", , "Ответ"
  End Select
ExitLabel:
End Sub


Добавлено через 8 минут и 9 секунд
Когда делаешь программы без этой защиты, результат при неправильных действиях пользователя бывает непредсказуемым smile

Автор: Hates 18.10.2008, 07:37
Огромное вам спасибо за помощь, всё проект решён, всё получилось как и хотел smile , ещё раз СПАСИБО!!!

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)