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
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
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
Что что?по-американски
wd = WeekDay(now, vbMonday)
Там все равно ошибка. Не стоит использовать тот код. Ошибка будет, если первый день месяца попадет на Воскресенье.Вот так считается: (ссылка удалена, т.к. стала недействительной)Дату то на актуальную коммент не переставил)
WD_first = Weekday(FirstDate, vbMonday)
Да,например 1 февраля 15 года накосячит.Ошибка будет, если первый день месяца попадет на Воскресенье.
Так я тебе разницу объяснял. Попробуй написать без vbMonday и сравни результат.так объявлена же?
Вот где ошибка!' Если добавить 28 дней и мы не вылезем за последний день месяца, значит суббот = 5, иначе 4
SatCnt = IIf(Sat_Date + 4 * 7 > LastDate, 4, 5)
SatCnt = IIf(Sat_Date + 4 * 7 > LastDate, 4, 5)
Dim SumDau
SumDay = Sat_Date + 4 * 7
SatCnt = IIf(SumDay > LastDate, 4, 5)
SatCnt = IIf(Sat_Date + 4 * 7 > LastDate, 4//четыре = ошибка потому что условие не выполнимо,поэтому 5//, 5)
Это не тебе указываю,это мне для самообразования.зачем ты указываешь на мою ошибку. Я и так ее знаю.
С какого перепугу?IIF не поддерживает операции вычисления внутри себя
Объявляешь одну переменную, используешь другую.Dim SumDau
SumDay = Sat_Date + 4 * 7
SatCnt = IIf(SumDay > LastDate, 4, 5)
Каким образом тогда в ответе получается число 5, если по твоей логике IIF всегда берет False-часть?четыре = ошибка потому что условие не выполнимо
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?