Sub ЗаполнениеСменами()
'aequit 03.03.2020 v.3
Dim b As Long, d As Long, i As Long, h1 As Long, h2 As Long, v As Long, k As Long, g As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
d = Worksheets("conf").Range("B4") + 5
b = 6
Do While Range("AL" & b).HasFormula
    b = b + 1
Loop
For g = 6 To b
    h1 = 0
    h2 = 0
    For i = 6 To d
        If Cells(g, i) <> Empty And Cells(g, i + 1) <> Empty Then
            If h1 = 0 Then h1 = i
            If h1 > 0 And h1 <> i And h2 = 0 Then
                h2 = i
                v = h2 - h1
                k = i
            End If
        Else
            If h1 > 0 And h2 > 0 And i = k + v Then
                Cells(g, i) = Cells(g, h1)
                If i < d Then
                    Cells(g, i + 1) = Cells(g, h1 + 1)
                End If
                k = i
            End If
        End If
    Next i
Next g
Select Case Worksheets("conf").Range("B4")
    Case Is = 30
        Range(Cells(6, d + 1), Cells(b - 1, d + 1)).ClearContents
    Case Is = 29
        Range(Cells(6, d + 1), Cells(b - 1, d + 2)).ClearContents
    Case Is = 28
        Range(Cells(6, d + 1), Cells(b - 1, d + 3)).ClearContents
End Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
Sub ЗаполнениеСменамиПоОдной()
'aequit 03.03.2020
Dim b As Long, d As Long, i As Long, h1 As Long, h2 As Long, v As Long, k As Long, g As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
d = Worksheets("conf").Range("B4") + 5
b = 6
Do While Range("AL" & b).HasFormula
    b = b + 1
Loop
For g = 6 To b
    h1 = 0
    h2 = 0
    For i = 6 To d
        If Cells(g, i) <> Empty And Cells(g, i + 1) <> Empty Then
            h1 = i
            k = i + 4
        Else
            If h1 > 0 And i = k Then
                Cells(g, i) = Cells(g, h1)
                If i < d Then
                    Cells(g, i + 1) = Cells(g, h1 + 1)
                End If
                k = i + 4
            End If
        End If
    Next i
Next g
If Worksheets("conf").Range("B4") < 31 Then
    Range(Cells(6, d + 1), Cells(b - 1, d + 1)).ClearContents
End If
Select Case Worksheets("conf").Range("B4")
    Case Is = 30
        Range(Cells(6, d + 1), Cells(b - 1, d + 1)).ClearContents
    Case Is = 29
        Range(Cells(6, d + 1), Cells(b - 1, d + 2)).ClearContents
    Case Is = 28
        Range(Cells(6, d + 1), Cells(b - 1, d + 3)).ClearContents
End Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
Sub ЗаполнениеВосьмерками()
'aequit 03.03.2020
Dim b As Long, d As Long, i As Long, g As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim wsC As Worksheet
Set wsC = Worksheets("conf")
d = wsC.Range("B4") + 5
b = 6
Do While Range("AL" & b).HasFormula
    b = b + 1
Loop
For g = 6 To b
    For i = 6 To d
        If Weekday(DateSerial(wsC.Range("D2"), wsC.Range("A3"), Cells(5, i)), 2) < 6 Then
            Cells(g, i) = 8
        Else
            Cells(g, i) = Empty
        End If
    Next i
Next g
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub