VB 6 Работа с датами на VB6

[Кирилл]

Привет.

Пока по твикеру контексного меню суд да дело,испытал работу с датами:

Private Sub Form_Load()
 
    Dim my_date
    Dim y, m, d
    my_date = Date 'переменная - реальная дата
    ' распарсим реальную дату
    y = DatePart("yyyy", my_date)
    m = DatePart("m", my_date)
    d = DatePart("d", my_date)
 
 
    my_date_part = d31  ' тут у нас дата - последнее число текущего месяца
    ' парсим дату конца месяца
    Y1 = DatePart("yyyy", my_date_part)
    m1 = DatePart("m", my_date_part)
    d1 = DatePart("d", my_date_part)
 
    d01 = DateSerial(Year(Now), Month(Date), 1) ' Получаем первое число текущего месяца
    d31 = DateAdd("m", 1, d01) - 1 'Последнее число текущего месяца
    d_no = d01 + 6 - Weekday(d - 1) 'дата первой субботы этого месяца
    d_no2 = d01 + 7 - Weekday(d - 1) 'дата первого воскресения этого месяца
 
 
 
    NoJob = (d1 / 7) ' Количество недель в месяце
    NoJob2 = Int(NoJob) ' Количество полных недель
 
    Frame1.Caption = Date
    tbDay.Text = NoJob2
 
 
 
 
 
End Sub

Задача - высчитать количество суббот и воскресений в месяце.
Математикой не получается.
Причем должна оставаться возможность вручную указывать выходной день,который в итоге не будет считаться.
Мож я про какие функции не знаю?

в мыслях:
for / i (перебор из количества дней в месяце по возвращенным значениям сб и вс)

у меня такой for не получается - не работет.

 

[Dragokas]

Привет.

Я напишу чуть короче твои функции.
На счет FOR. Даты можно спокойно печислять в нем.
Для этого все типы переменных должны быть Date.
Программа остановится на Stop и через F8 ты сможешь увидеть в окне Locals, что к дате постоянно прибавляется 1 день.

Sub main()
    Dim FirstDate    As Date
    Dim LastDate     As Date
    Dim myDate       As Date
    Dim curDate      As Date
    Dim SunCnt       As Long
    Dim SatCnt       As Long
 
    myDate = Date   'берем в качестве даты сегодняшнюю

    'последняя дата месяца
    LastDate = DateSerial(Year(myDate), Month(myDate) + 1, 0)
 
    'первая дата месяца
    FirstDate = DateSerial(Year(myDate), Month(myDate), 1)
 
    SatCnt = 0: SunCnt = 0
    'если считать, как американцы
    For curDate = FirstDate To LastDate
        If Weekday(curDate) = vbSaturday Then SatCnt = SatCnt + 1
        If Weekday(curDate) = vbSunday Then SunCnt = SunCnt + 1
    Next
 
    SatCnt = 0: SunCnt = 0
    'если по-нашему
    Stop
    For curDate = FirstDate To LastDate
        If Weekday(curDate, vbMonday) = 6 Then SatCnt = SatCnt + 1
        If Weekday(curDate, vbMonday) = 7 Then SunCnt = SunCnt + 1
    Next
 
    ' результаты будут одинаковыми (что по-американски - Воскресенье - первый день недели), что по нашим рассчетам
    Debug.Print "Суббот: " & SatCnt
    Debug.Print "Воскресений: " & SunCnt
End Sub

Второй вариант на чистой математике и будет работать быстрее, т.к. нет циклов.
Отправная точка - кол-во суббот (или воскресений) в месяце всегда или 4, или 5.

Sub main2()
    Dim FirstDate    As Date
    Dim LastDate     As Date
    Dim myDate       As Date
    Dim Sat_Date     As Date
    Dim SunCnt       As Long
    Dim SatCnt       As Long
    Dim WD_first     As Long
 
    'myDate = Date   'берем в качестве даты сегодняшнюю
    myDate = CDate("10.01.2015")

    'последняя дата месяца
    LastDate = DateSerial(Year(myDate), Month(myDate) + 1, 0)
 
    'первая дата месяца
    FirstDate = DateSerial(Year(myDate), Month(myDate), 1)

    'День недели первого дня месяца
    WD_first = Weekday(FirstDate, vbMonday)
 
    'День, который выпадает на первую субботу месяца
    Sat_Date = FirstDate + (6 - WD_first)
 
    ' Если добавить 28 дней и мы не вылезем за последний день месяца, значит суббот = 5, иначе 4
    SatCnt = IIf(Sat_Date + 4 * 7 > LastDate, 4, 5)

    ' С воскресеньем тоже самое, но на день больше
    SunCnt = IIf(Sat_Date + 4 * 7 + 1 > LastDate, 4, 5)
 
    Debug.Print "Суббот: " & SatCnt
    Debug.Print "Воскресений: " & SunCnt
End Sub

На счет функции DateSerial, то ей можно передать 0, т.е. 0-вой день месяца - она воспримет это
как директиву - показать дату на день меньшую, чем 1-е число месяца (т.е. по сути последний день предыдущего месяца).

 

[Кирилл]

В последнем варианте количество воскресений не правильно определяется)
Посмотрю в чем ошибка.

 

[Dragokas]

Может быть. Я с математикой не сильно дружу.
Вообще, можно как-то еще проще. Скажи, какую дату ты проверял?А, да не верно будет.
Сейчас подумаю, как реализовать.

 

[Кирилл]

Сегодняшнюю.О, я тупищто!
Дату то на актуальную коммент не переставил)
Работает функция то.

 

[Dragokas]

Придумал. Если тоже самое переписать по-американски, то заработает.
К сожалению, должен убегать.

 

[Кирилл]

по-американски

Что что?

 

[Dragokas]

Если ты спросишь у WeekDay, какой порядковый номер дня недели в Воскресенье,
то он тебе ответит - 1. (потому что у них Воскресенье - это первый день недели.).

По этому по-нашему нужно конкретно указывать какой день недели у нас считается первым:

wd = WeekDay(now, vbMonday)

Дату то на актуальную коммент не переставил)

Там все равно ошибка. Не стоит использовать тот код. Ошибка будет, если первый день месяца попадет на Воскресенье.Вот так считается: (ссылка удалена, т.к. стала недействительной)

 

[Кирилл]

WD_first = Weekday(FirstDate, vbMonday)

так объявлена же?
'День недели первого дня месяца
WD_first =Weekday(FirstDate, vbMonday)

Определяет верно,математика ошибается)

Ошибка будет, если первый день месяца попадет на Воскресенье.

Да,например 1 февраля 15 года накосячит.
Ровно на один день.

 

[Dragokas]

так объявлена же?

Так я тебе разницу объяснял. Попробуй написать без vbMonday и сравни результат.

 

[Кирилл]

А,тогда понятно,пробовал уже.

 

[Кирилл]

' Если добавить 28 дней и мы не вылезем за последний день месяца, значит суббот = 5, иначе 4
SatCnt = IIf(Sat_Date + 4 * 7 > LastDate, 4, 5)

Вот где ошибка!
Условие верно только в том случае,если воскресение при этом не первое число.

 

[Dragokas]

Koza Nozdri, зачем ты указываешь на мою ошибку. Я и так ее знаю.
Если хочешь, исправь. Мне некогда.

 

[Кирилл]

Дальше больше.
У тебя ошибка кода:

SatCnt = IIf(Sat_Date + 4 * 7 > LastDate, 4, 5)

IIF не поддерживает операции вычисления внутри себя,то есть надо вот так:

Dim SumDau
SumDay = Sat_Date + 4 * 7
SatCnt = IIf(SumDay > LastDate, 4, 5)

Иначе получим:

SatCnt = IIf(Sat_Date + 4 * 7 > LastDate, 4//четыре = ошибка потому что условие не выполнимо,поэтому 5//, 5)

А число дня тут не при делах)

зачем ты указываешь на мою ошибку. Я и так ее знаю.

Это не тебе указываю,это мне для самообразования.
+ кто то почитает и тоже поймет возможно.

 

[Dragokas]

IIF не поддерживает операции вычисления внутри себя

С какого перепугу?

Dim SumDau
SumDay = Sat_Date + 4 * 7
SatCnt = IIf(SumDay > LastDate, 4, 5)

Объявляешь одну переменную, используешь другую.
Пиши Option Explicit, если часто ошибаешься в названиях.
Переменная SumDay должна иметь тип Date.
Ты объявляешь как Variant (так происходит когда ты не пишешь ключевое слово as <тип данных>).
Variant - это контейнер, который может хранить в себе любой тип данных.
Тип данных определяется автоматически как только первая инициализация переменной (присвоение нового значение).
О типах данных можешь почитать [URL='xttp://www.studfiles.ru/dir/cat32/subj1259/file11575/view109733.html']здесь[/URL].

четыре = ошибка потому что условие не выполнимо

Каким образом тогда в ответе получается число 5, если по твоей логике IIF всегда берет False-часть?

 

[Кирилл]

Уфф!
Разобрался.
Мое недопонимание + в одной строке ошибка была.

Спасибо.