Vba excel рабочие дни

0 / 0 / 0

Регистрация: 15.08.2018

Сообщений: 30

Здравствуйте!

Не смог найти подходящую тему. Задача состоит в том, что-бы посчитать количество рабочих дней недели и их комбинации (понедельник; понедельник, среда, пятница; и т.д.) в интервале дат. При этом нужно учитывать праздничные дни. Нашел только как их по отдельности искать.

Loya

70 / 57 / 24

Регистрация: 06.12.2015

Сообщений: 300

А где в файле код?

Посчитать рабочие дни можно так (предполагаем, что как в приложенном файле начало периода указано в ячейкеА1, конец периода в ячейке А2, перечисление праздничных дней начинается с ячейки А7):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

Private Sub main()
 
Dim Date1, Date2 As Date
Date1 = CDate(Cells(1, 1))
Date2 = CDate(Cells(2, 1))
MsgBox ("Рабочих дней " & workDays(Date1, Date2, 7))
 
End Sub
 
Private Function workDays(ByVal bDate As Date, ByVal eDate As Date, startWeekends As Long) As Integer
 
Dim wDays As Integer
Dim lastRow As Long
 
For d = bDate To eDate
    itsday = Weekday(d, vbMonday)
    If itsday <> 6 Or itsday <> 7 Then
        wDays = wDays + 1
    End If
Next d
 
lastRow = Cells(Rows.Count, 1).End(xlUp).Row 'получаем последнюю заполненную ячейку
weekends = lastRow - startWeekends + 1 'вычисляем количество праздничных дней
wDays = wDays - weekends
 
workDays = wDays
 
End Function

Про комбинации рабочих дней не совсем понятно, по одному дню это тоже комбинация? Должно быть:
понедельник
вторник
…
понедельник, вторник, среда
…
понедельник, вторник, среда, четверг, пятница
???

0 / 0 / 0

Регистрация: 15.08.2018

Сообщений: 30

Loya, спасибо огромное, за ответ!

Сейчас попробую понятнее объяснить что именно нужно:
есть интервал дат (на пример): 15.08.2018 — 23.08.2018. В него входят:2 среды, 2 четверга, 1 пятница, 1 сб, 1 вс, 1 пн и 1 вт.
Нужно заставить выяснить это Exel, потом что-бы он проверил не приходятся ли эти дни на праздники и сложил их.

70 / 57 / 24

Регистрация: 06.12.2015

Сообщений: 300

Т.е. вывод по заданным датам (15.08.2018 — 23.08.2018) должен быть:
среда — 2шт.
четверг — 2шт.
пятница — 1шт.
суббота — 1шт.
воскресенье — 1шт.
понедельник — 1шт.
вторник — 1шт.
Всего рабочих дней: 7шт.

А, например, за период 3.05.2018-14.05.2018 вывод должен быть такой:
четверг — 2шт.
пятница — 2шт.
суббота — 2шт.
воскресенье — 2шт.
понедельник — 2шт.
вторник — 1шт.
среда — 1шт.
Всего рабочих дней: 9шт.
(т.к. 12 дней — 4 выходных и — 1 праздник)

Так что-ли?

Burk

1813 / 1135 / 346

Регистрация: 11.07.2014

Сообщений: 4,002

PiLLyulk, такой вариант

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

Function DayW(D1 As Date, D2 As Date)
Dim I As Integer, S As Integer, S1 As Integer, Wd As Integer
S = 0
'количество дней недели в заданном интервале
'начало недели - воскресенье
For I = 1 To 7
  Cells(I, 1) = (D2 - I)  7 - (D1 - I - 1)  7
  If I > 1 And I < 7 Then S = S + Cells(I, 1)
Next
I = 10
'начиная с десятой строки в первом столбце располагаются даты праздников
Do While Cells(I, 1) <> ""
  Wd = Weekday(Cells(I, 1))
  If Wd > 1 And Wd < 7 And Cells(I, 1) >= D1 And Cells(I, 1) <= D2 Then S = S - 1
  I = I + 1
Loop
DayW = S
End Function
 
Sub proba()
Dim D1 As Date, D2 As Date
D1 = CDate("09.08.2018")
D2 = CDate("25.08.2018")
MsgBox DayW(D1, D2)
End Sub

Добавлено через 8 минут
PiLLyulk, во втором столбце с первой по седьмую строку можно ввести дни недели воскресенье — суббота

0 / 0 / 0

Регистрация: 15.08.2018

Сообщений: 30

Loya, добрый день.

Да, я думаю, что как-то так это должно быть. Тут самое главное что-бы можно было выбрать конкретные дни недели.
Например (нужны вторники и четверги):
за период 3.05.2018-14.05.2018 вывод должен быть такой:
четверг — 2шт. 1 четверг — это День победы, он не должен попасть в результат.
пятница — 2шт.
суббота — 2шт.
воскресенье — 2шт.
понедельник — 2шт.
вторник — 1шт.
среда — 1шт.
Всего 1 вторник и 2 четверга, 1 из этих дней праздничный, значит всего 2 штуки.

Добавлено через 29 минут
Burk, если четно, я не понял как эта штука работает. Не смог ее выполнить. Я пока очень плохо в этом разбираюсь.

Вот эта часть вообще не понял что делать должна:

1813 / 1135 / 346

Регистрация: 11.07.2014

Сообщений: 4,002

Да, тяжелый случай, эта часть вычитает из рабочих дней праздники заданного промежутка.
Для того, чтобы посмотреть всё надо запустить макрос, он здесь единственный proba. Промежуток заданный в моём примере, D1 = и D2 = в этом макросе. Запустить макрос из вкладки Разработчик — Макросы — proba. Или спросите у друзей, которые продвинулись в экселе дальше, чем вы (если такие есть)

Добавлено через 7 минут
В тексте функции тоже есть пояснения. Ещё раз — с ячейки А10 вниз введите даты праздников

0 / 0 / 0

Регистрация: 15.08.2018

Сообщений: 30

Вроде понял теперь, она перебирает даты, начиная с 10 строки, и если они попадают в заданный интервал, то вычитает их количество.
Если взять интервал с 1.05.2019 по 15.05.2019, то Проба выдает 9 дней. Там их всего 15, из них 4 выходных и 1 праздничный день. Не понимаю что она имеет ввиду.
Это какие-то условия по дням недели?

Спасибо, что возитесь со мной.

Loya

70 / 57 / 24

Регистрация: 06.12.2015

Сообщений: 300

Праздничных два (1.05.2019 и 9.05.2019).

Вот тут непонятно, нужно праздничный учитывать как вторник или нет? Если нужно то вот так примерно:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51

Private Sub main()
 
Dim bDate As Date, eDate As Date 'переменные для периода
Dim startWeekend As Long 'строка, с которой начинаются праздники
Dim workDays As Integer 'переменная для количества рабочих дней
Dim lastRow As Long 'переменная для последней заполненной ячейки праздников
Dim arrWorkDays(1 To 7) As Integer 'массив для дней недели
Dim str As String, days() As String 'переменные для запрашиваемых дней
Dim flagWeekday As Boolean 'флаг
 
bDate = CDate(Cells(1, 1))
eDate = CDate(Cells(2, 1))
startWeekend = 7
 
lastRow = Cells(Rows.Count, 1).End(xlUp).Row 'получаем последнюю заполненную ячейку
For d = bDate To eDate 'цикл по датам в периоде
    itsday = Weekday(d, vbMonday) 'определяем день недели
    arrWorkDays(itsday) = arrWorkDays(itsday) + 1 'увеличиваем в массиве тот разряд, к которому относится день недели
    If itsday <> 6 And itsday <> 7 Then 'если это не суббота и не воскресенье
        flagWeekday = False 'сбрасываем флаг
        For j = startWeekend To lastRow 'пробегаемся по праздникам
            If Cells(j, 1) = d Then 'если есть в списке праздников
                flagWeekday = True 'устанавливаем флаг
            End If
        Next j
        If Not flagWeekday Then 'если флаг не установлен
            workDays = workDays + 1 'то увеличиваем счётчик рабочих дней
        End If
    End If
Next d
 
str = InputBox("Введите через запятую номера дней недели от 1 до 7", "Ввод данных")
days = Split(str, ",") 'разделяем полученные дни по запятым
 
For i = 0 To UBound(days) 'перебираем циклом запрошенные дни 
    Call showResult(days(i), arrWorkDays(i + 1)) 'вызываем функцию, которая покажет день недели и количество этих дней
Next i
MsgBox ("Общее количество рабочих дней " & workDays)
End Sub
 
Private Sub showResult(ByVal dName As String, ByVal result As Integer)
    If IsNumeric(dName) Then
        If CInt(dName) > -1 And CInt(dName) < 8 Then
            MsgBox (WeekdayName(CLng(dName)) & " " & result) 'показываем день недели и количество этих дней в периоде
        Else
            MsgBox ("Значение не является днём недели!")
        End If
    Else
        MsgBox ("Значение не является числом!")
    End If
End Sub

Если праздничный не нужно учитывать, как день недели, то подправьте условие.

Уважаю Вас и Ваше желание помочь, но зачем же так грубо? Все когда-то начинали. Разбирать чужой код даже опытному порой бывает сложно, а начинающему это сложно втройне.

Добавлено через 3 минуты

Можно жмакать кнопку «Спасибо» по сообщением, тогда у тех, кто «возится» будет расти репутация!

0 / 0 / 0

Регистрация: 15.08.2018

Сообщений: 30

Loya, спасибо! Это, практически то, что нужно.

Точно, я пор 1 мая забыл!

Дни недели, попадающие на праздники не нужно учитывать. По итогу, если взять тот же пример: с 1 мая 2019 по 15 мая 2019 и выбрать вторник и четверг, то ответ должен получиться 3. (2 вторникa и 1 четверг, который не праздничный).

Получается, что нужно еще раз перебрать праздничные дни?

1813 / 1135 / 346

Регистрация: 11.07.2014

Сообщений: 4,002

1813 / 1135 / 346

Регистрация: 11.07.2014

Сообщений: 4,002

70 / 57 / 24

Регистрация: 06.12.2015

Сообщений: 300

Нет, зачем два раза? Лучше переписать придерживаясь необходимых условий. Просто непонятно, субботы и воскресенья нужно считать или нет? Мы их не считаем в количестве рабочих дней, а общее количество суббот и воскресений нужно? Если нужно, то опять вопрос, считаем ли субботу, если она выпадает на праздник (например, 5 января)? Т.е. нужно определиться с условием, для того, чтоб понять в какой момент перебирать праздничные дни, а в какой проверять день на «выходнойвость».

1813 / 1135 / 346

Регистрация: 11.07.2014

Сообщений: 4,002

0 / 0 / 0

Регистрация: 15.08.2018

Сообщений: 30

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

Loya

70 / 57 / 24

Регистрация: 06.12.2015

Сообщений: 300

В таком случае сначала проверяем праздники, и если не праздничный, то записываем в массив, затем проверяем на выходнойство, если будни то увеличиваем ещё и счётчик рабочих дней. 5 января в этом случае в количество суббот не попадёт, что соответствует условию:

Вот примерно так:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

Private Sub main()
 
Dim bDate As Date, eDate As Date
Dim startWeekend As Long
Dim workDays As Integer
Dim lastRow As Long
Dim arrWorkDays(1 To 7) As Integer
Dim str As String, days() As String
Dim flagWeekday As Boolean
 
bDate = CDate(Cells(1, 1))
eDate = CDate(Cells(2, 1))
startWeekend = 7
 
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
 
For d = bDate To eDate 
    itsday = Weekday(d, vbMonday) 'определяем день недели
    flagWeekday = False 'сбрасываем флаг
    For j = startWeekend To lastRow 'пробегаемся по праздникам
        If Cells(j, 1) = d Then
            flagWeekday = True 'если нашли, то устанавливаем флаг
            Exit For 'выходим из цикла т.к. нету смысла искать дальше
        End If
    Next j
    If Not flagWeekday Then
        arrWorkDays(itsday) = arrWorkDays(itsday) + 1 'добавляем в массив
        If itsday <> 6 And itsday <> 7 Then
            workDays = workDays + 1 'если это не выходной, то увеличиваем счётчик рабочих дней
        End If
    End If
Next d
 
str = InputBox("Введите через запятую номера дней недели от 1 до 7", "Ввод значений")
days = Split(str, ",")
 
For i = 0 To UBound(days)
    If IsNumeric(days(i)) Then
        If CInt(days(i)) > 0 And CInt(days(i)) < 8 Then
            MsgBox (WeekdayName(CLng(days(i))) & " " & arrWorkDays(days(i)))
        Else
            MsgBox ("Значение не является днём недели!")
        End If
        
    Else
        MsgBox ("Значение не является числом!")
    End If
Next i
MsgBox ("Общее количество рабочих дней " & workDays)
End Sub

0 / 0 / 0

Регистрация: 15.08.2018

Сообщений: 30

Спасибо! Это то, что нужно!

Добавлено через 53 минуты
Loya, здравствуйте.

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

Loya

70 / 57 / 24

Регистрация: 06.12.2015

Сообщений: 300

PiLLyulk, ну смотрите, вот тут:

Объявлены две переменные, которые как раз инициализируются данными из ячеек, преобразованными к типу Date. Т.е. если Вам нужно брать дни тоже из ячеек, то по аналогичному принципу и действуете. Измените вот эту строку:

На:

1

str = Cells(row, col)

где row — это будет номер строки, а col — номер колонки той ячейки, из которой необходимо получать данные.

PiLLyulk

0 / 0 / 0

Регистрация: 15.08.2018

Сообщений: 30

Loya, добрый день.

А как убрать MsgBox, который выдает кол-во дней и сделать так что-бы сумма выбранных дней недели попадала в ячейку с функцией? Ну то-есть не понедельник: 2, среда: 2, кол-во рабочих:7, а просто 4 (среды+ понедельники)?

Добавлено через 7 часов 14 минут
Добрый день!

Пока получается такой вариант.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

Function Часы(bDate As Date, eDate As Date)
 
Dim startWeekend As Long
Dim workDays As Integer
Dim lastRow As Long
Dim arrWorkDays(1 To 7) As Integer
Dim str As String, days() As String
Dim flagWeekday As Boolean
 
 
startWeekend = 20
 
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
 
For d = bDate To eDate
    itsday = Weekday(d, vbMonday) 'определяем день недели
    flagWeekday = False 'сбрасываем флаг
    For j = startWeekend To lastRow 'пробегаемся по праздникам
        If Cells(j, 1) = d Then
            flagWeekday = True 'если нашли, то устанавливаем флаг
            Exit For 'выходим из цикла т.к. нету смысла искать дальше
        End If
    Next j
    If Not flagWeekday Then
        arrWorkDays(itsday) = arrWorkDays(itsday) + 1 'добавляем в массив
        If itsday <> 6 And itsday <> 7 Then
            workDays = workDays + 1 'если это не выходной, то увеличиваем счётчик рабочих дней
        End If
    End If
Next d
 
str = Cells(5, 12)
days = Split(str, ",")
 
For I = 0 To UBound(days)
    If IsNumeric(days(I)) Then
        If CInt(days(I)) > 0 And CInt(days(I)) < 8 Then
      'MsgBox (WeekdayName(CLng(days(I))) & " " & arrWorkDays(days(I))) (msgBox weekdays)
            Часы = Часы + arrWorkDays(days(I)) ' Выводит сумму дней недели в ячейку
        Else
            MsgBox ("Значение не является днём недели!")
        End If
        
    Else
        MsgBox ("Значение не является числом!")
    End If
Next I
 
End Function

Не могу выбор дней недели сделать аргументом.

1
2

str = Cells(5, 12)
days = Split(str, ",")

Собственно только этого для счастья и не хватает.

70 / 57 / 24

Регистрация: 06.12.2015

Сообщений: 300

А что конкретно не получается? Ошибку какую-то выдает или что?