oos

Attribute VB_Name = "oos_days_count"
Option Explicit
Sub count_days()

Dim all_days As Integer
Dim oos_days As Integer
Dim rng_days As Range
Dim x_day As Range
Dim r As Long
Dim x_offs As Long
Dim str_zavod As String
Dim zavod_name As String
Dim pos_id As Long
Dim pos_name As String
Dim ozm4sum As Long
Dim total_rng As Range
Dim rng_search As Range
'-------------------------
Dim i As Variant
Dim k As Variant
Dim d As Integer
'-------------------------
Dim arrDates() As Date
Dim ar_dmnsn As Integer
Dim oos_start() As String
Dim oos_end() As String
Dim dt_split As Boolean
Dim ar_data() As Variant
'--------------------------
Dim t As Variant

    Set rng_search = oos_ws_sales.Range(oos_ws_sales.Range("A4"), oos_ws_sales.Range("A4").End(xlDown))

    oos_ws_total.Range(oos_ws_total.Range("A2"), oos_ws_total.Range("A2").End(xlDown)).EntireRow.Delete

    all_days = oos_ws_ost_jti.Range(oos_ws_ost_jti.Range("G2"), oos_ws_ost_jti.Range("G2").End(xlToRight)).Columns.Count
    r = oos_ws_ost_jti.Range(oos_ws_ost_jti.Range("D3"), oos_ws_ost_jti.Range("D3").End(xlDown)).rows.Count
    Set rng_days = oos_ws_ost_jti.Range(oos_ws_ost_jti.Range("G2"), oos_ws_ost_jti.Range("G2").End(xlToRight))

    For x_offs = 1 To r Step 1
        ar_dmnsn = 0
        oos_days = 0
        Set rng_days = rng_days.Offset(1, 0)

            For Each x_day In rng_days
                If Application.WorksheetFunction.SumIfs _
                    (x_day.EntireColumn, _
                    x_day.End(xlToLeft).Offset(0, 1).EntireColumn, x_day.End(xlToLeft).Offset(0, 1), _
                    x_day.End(xlToLeft).Offset(0, 5).EntireColumn, x_day.End(xlToLeft).Offset(0, 5)) = 0 Then
                    oos_days = oos_days + 1
                    ReDim Preserve arrDates(1 To oos_days)
                    arrDates(oos_days) = x_day.End(xlUp).Offset(1, 0).Value
                End If
            Next x_day
 '----------------------------------------------------------------------------------------------------------

                If oos_days > 0 Then

                ar_dmnsn = 1

                For i = 1 To UBound(arrDates)

                    'Первая дата обрабатывается как отдельный случай.
                    'Определяется начальная размерность для массивов с начальной и конечной датами.

                    If i = 1 Then

                        ReDim oos_start(1 To ar_dmnsn)
                        ReDim oos_end(1 To ar_dmnsn)

                        oos_start(ar_dmnsn) = arrDates(i)

                    End If

                    'Если между датами промежуток более 1 дня - то делим на 2 промежутка.
                    'Увеличивая размер массивов с начальной и конечной датами.

                    If dt_split Then

                        ReDim Preserve oos_start(1 To ar_dmnsn)
                        oos_start(ar_dmnsn) = arrDates(i)
                        ReDim Preserve oos_end(1 To ar_dmnsn)

                        dt_split = False

                    End If

                    'Если период состоит из одной даты.

                    If UBound(arrDates) = 1 Then
                        ReDim oos_end(1 To ar_dmnsn)
                        oos_end(ar_dmnsn) = arrDates(i) + 1
                    End If

                    'Последняя дата в периоде.

                    If i = UBound(arrDates) Then
                        ReDim Preserve oos_end(1 To ar_dmnsn)
                        oos_end(ar_dmnsn) = arrDates(i) + 1
                        Exit For
                    End If

                    'Сравниваем даты, если они не являются соседними, то увеличиваем переменную отвечающую за размер массивов с датами.
                    'И ставим метку для разделение периода в следующей итерации цикла.

                    If arrDates(i) + 1 = arrDates(i + 1) Then

                        oos_end(ar_dmnsn) = arrDates(i + 1)

                    Else

                        oos_end(ar_dmnsn) = arrDates(i)
                        ar_dmnsn = ar_dmnsn + 1
                        dt_split = True

                    End If

                Next i

                End If

                    If ar_dmnsn > 0 Then

                    For k = 1 To ar_dmnsn

                        If oos_days > 0 Then
                            str_zavod = rng_days.End(xlToLeft).Offset(0, 1).Value
                            zavod_name = rng_days.End(xlToLeft).Offset(0, 2).Value
                            pos_id = rng_days.End(xlToLeft).Offset(0, 3).Value
                            pos_name = rng_days.End(xlToLeft).Offset(0, 4).Value
                            ozm4sum = rng_days.End(xlToLeft).Offset(0, 5).Value

                                If is_exception(pos_id) Then
                                    GoTo skip
                                End If
                            Set total_rng = oos_ws_total.Cells(oos_ws_total.Cells.rows.Count, 1).End(xlUp).Offset(1, 0) 'Первая пустая ячейка
                            total_rng.Value = str_zavod                                                                 'Проставляем номер завода
                            total_rng.Offset(0, 1).Value = zavod_name
                            total_rng.Offset(0, 2).Value = pos_id                                                       'МАТЕРИАЛ
                            total_rng.Offset(0, 3).Value = pos_name                                                     'Pos Name

                            total_rng.Offset(0, 4).Value = DateDiff("d", oos_start(k), oos_end(k))                      'days with OOS
                            total_rng.Offset(0, 5).Value = double_vpr(str_zavod, 2, pos_id, rng_search, 8)              'Sales p\day
                            total_rng.Offset(0, 6).Value = total_rng.Offset(0, 4).Value * total_rng.Offset(0, 5).Value  'OOS boxes
                            total_rng.Offset(0, 7).Value = Application.WorksheetFunction.SumIfs _
                                (oos_ws_plan.Cells.Find("KOL_VO_KOROBOV").EntireColumn, _
                                oos_ws_plan.Cells.Find("MATERIAL_ID").EntireColumn, ozm4sum, _
                                oos_ws_plan.Cells.Find("ZAVOD_ID").EntireColumn, str_zavod)                             'Plan
                            total_rng.Offset(0, 8).Value = Application.WorksheetFunction.SumIfs _
                                (oos_ws_cursales.Cells.Find("Объем продаж").EntireColumn, _
                                oos_ws_cursales.Cells.Find("Завод").EntireColumn, str_zavod, _
                                oos_ws_cursales.Cells.Find("ОЗМ для суммирования").EntireColumn, ozm4sum)               'Current Sales
                            total_rng.Offset(0, 9).Value = oos_start(k)                                                 'Start Date
                            total_rng.Offset(0, 10).Value = oos_end(k)                                                  'End Date

                        End If

                    Next k
                    End If
skip:
    Next x_offs

End Sub

Attribute VB_Name = "oos_days_count_array"
Option Explicit
Sub count_days_array()

Dim all_days As Integer
Dim oos_days As Integer
Dim rng_days As Range
Dim x_day As Range
Dim r As Long
Dim x_offs As Long
'-------------------------------------
Dim zavod_id As New Collection
Dim zavod_name As New Collection
Dim pos_id As New Collection
Dim pos_name As New Collection
Dim oosd As New Collection
Dim slday As New Collection
Dim oosbox As New Collection
Dim plan As New Collection
Dim slcur As New Collection
Dim stdate As New Collection
Dim enddate As New Collection
'---------------------------------------
Dim ozm4sum As Long
Dim total_rng As Range
Dim rng_search As Range
'-------------------------
Dim i As Variant
Dim k As Variant
Dim d As Integer
'-------------------------
Dim arrDates() As Date
Dim ar_dmnsn As Integer
Dim oos_start() As String
Dim oos_end() As String
Dim dt_split As Boolean
Dim ar_data() As Variant
'--------------------------
Dim t As Variant
'Определяем коллекции
'------------------------------------------

    Call AccelerateExcel(True)

    On Error GoTo fin

    zavod_id.Add "Завод"
    zavod_name.Add "Завод Имя"
    pos_id.Add "Материал"
    pos_name.Add "Наименование"
    oosd.Add "Дней ООС"
    slday.Add "Продаж в день"
    oosbox.Add "ООС (КОР)"
    plan.Add "План"
    slcur.Add "Продажи"
    stdate.Add "Дата нач"
    enddate.Add "Дата оконч"

'------------------------------------------

    Set rng_search = oos_ws_sales.Range(oos_ws_sales.Range("A4"), oos_ws_sales.Range("A4").End(xlDown))

    oos_ws_total.Range(oos_ws_total.Range("A2"), oos_ws_total.Range("A2").End(xlDown)).EntireRow.Delete

    all_days = oos_ws_ost_jti.Range(oos_ws_ost_jti.Range("G2"), oos_ws_ost_jti.Range("G2").End(xlToRight)).Columns.Count
    r = oos_ws_ost_jti.Range(oos_ws_ost_jti.Range("D3"), oos_ws_ost_jti.Range("D3").End(xlDown)).rows.Count
    Set rng_days = oos_ws_ost_jti.Range(oos_ws_ost_jti.Range("G2"), oos_ws_ost_jti.Range("G2").End(xlToRight))

    For x_offs = 1 To r Step 1
        ar_dmnsn = 0
        oos_days = 0
        Set rng_days = rng_days.Offset(1, 0)

            For Each x_day In rng_days
                If Application.WorksheetFunction.SumIfs _
                    (x_day.EntireColumn, _
                    x_day.End(xlToLeft).Offset(0, 1).EntireColumn, x_day.End(xlToLeft).Offset(0, 1), _
                    x_day.End(xlToLeft).Offset(0, 5).EntireColumn, x_day.End(xlToLeft).Offset(0, 5)) = 0 Then
                    oos_days = oos_days + 1
                    ReDim Preserve arrDates(1 To oos_days)
                    arrDates(oos_days) = x_day.End(xlUp).Offset(1, 0).Value
                End If
            Next x_day
 '----------------------------------------------------------------------------------------------------------

                If oos_days > 0 Then

                ar_dmnsn = 1

                For i = 1 To UBound(arrDates)

                    'Первая дата обрабатывается как отдельный случай.
                    'Определяется начальная размерность для массивов с начальной и конечной датами.

                    If i = 1 Then

                        ReDim oos_start(1 To ar_dmnsn)
                        ReDim oos_end(1 To ar_dmnsn)

                        oos_start(ar_dmnsn) = arrDates(i)

                    End If

                    'Если между датами промежуток более 1 дня - то делим на 2 промежутка.
                    'Увеличивая размер массивов с начальной и конечной датами.

                    If dt_split Then

                        ReDim Preserve oos_start(1 To ar_dmnsn)
                        oos_start(ar_dmnsn) = arrDates(i)
                        ReDim Preserve oos_end(1 To ar_dmnsn)

                        dt_split = False

                    End If

                    'Если период состоит из одной даты.

                    If UBound(arrDates) = 1 Then
                        ReDim oos_end(1 To ar_dmnsn)
                        oos_end(ar_dmnsn) = arrDates(i) + 1
                    End If

                    'Последняя дата в периоде.

                    If i = UBound(arrDates) Then
                        ReDim Preserve oos_end(1 To ar_dmnsn)
                        oos_end(ar_dmnsn) = arrDates(i) + 1
                        Exit For
                    End If

                    'Сравниваем даты, если они не являются соседними, то увеличиваем переменную отвечающую за размер массивов с датами.
                    'И ставим метку для разделение периода в следующей итерации цикла.

                    If arrDates(i) + 1 = arrDates(i + 1) Then

                        oos_end(ar_dmnsn) = arrDates(i + 1)

                    Else

                        oos_end(ar_dmnsn) = arrDates(i)
                        ar_dmnsn = ar_dmnsn + 1
                        dt_split = True

                    End If

                Next i

                End If

                    If ar_dmnsn > 0 Then

                    For k = 1 To ar_dmnsn

                        If oos_days > 0 Then

                            zavod_id.Add rng_days.End(xlToLeft).Offset(0, 1).Value
                            zavod_name.Add rng_days.End(xlToLeft).Offset(0, 2).Value
                            pos_id.Add rng_days.End(xlToLeft).Offset(0, 3).Value
                            pos_name.Add rng_days.End(xlToLeft).Offset(0, 4).Value

                            ozm4sum = rng_days.End(xlToLeft).Offset(0, 5).Value

                            oosd.Add DateDiff("d", oos_start(k), oos_end(k))
                            'days with OOS
                            slday.Add double_vpr(zavod_id(zavod_id.Count), 2, pos_id(pos_id.Count), rng_search, 8)
                            'Sales p\day
                            oosbox.Add slday(slday.Count) * oosd(oosd.Count)
                            'OOS boxes
                            plan.Add Application.WorksheetFunction.SumIfs _
                                (oos_ws_plan.Cells.Find("KOL_VO_KOROBOV").EntireColumn, _
                                oos_ws_plan.Cells.Find("MATERIAL_ID").EntireColumn, ozm4sum, _
                                oos_ws_plan.Cells.Find("ZAVOD_ID").EntireColumn, zavod_id(zavod_id.Count))
                                'Plan
                            slcur.Add Application.WorksheetFunction.SumIfs _
                                (oos_ws_cursales.Cells.Find("Объем продаж").EntireColumn, _
                                oos_ws_cursales.Cells.Find("Завод").EntireColumn, zavod_id(zavod_id.Count), _
                                oos_ws_cursales.Cells.Find("ОЗМ для суммирования").EntireColumn, ozm4sum)
                                'Current Sales
                            stdate.Add oos_start(k)
                            'Start Date
                            enddate.Add oos_end(k)
                            'End Date

                        End If

                    Next k
                    End If
skip:
    Next x_offs


            For d = 1 To zavod_id.Count
                oos_ws_total.Cells(d, 1).Value = zavod_id(d)
                oos_ws_total.Cells(d, 2).Value = zavod_name(d)
                oos_ws_total.Cells(d, 3).Value = pos_id(d)
                oos_ws_total.Cells(d, 4).Value = pos_name(d)
                oos_ws_total.Cells(d, 5).Value = oosd(d)
                oos_ws_total.Cells(d, 6).Value = slday(d)
                oos_ws_total.Cells(d, 7).Value = oosbox(d)
                oos_ws_total.Cells(d, 8).Value = plan(d)
                oos_ws_total.Cells(d, 9).Value = slcur(d)
                oos_ws_total.Cells(d, 10).Value = stdate(d)
                oos_ws_total.Cells(d, 11).Value = enddate(d)
            Next d

fin:

            Call AccelerateExcel(False)

End Sub

Sub ar_tst()
Dim test_ar()
Dim wer As Collection
test_ar = oos_ws_total.Range("A1").CurrentRegion
Debug.Print 1
oos_ws_total.Range("A7:K12") = test_ar()

End Sub

Attribute VB_Name = "oos_functns"
Option Explicit
Function file_picker()

Dim strN As String
Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFilePicker)

fd.AllowMultiSelect = False
fd.Filters.Clear
fd.Filters.Add "Файлы Excel", "*.xlsx;*.xls;*.xlsm"
fd.InitialFileName = ThisWorkbook.Path

fd.Show

    If fd.SelectedItems.Count = 0 Then
        Exit Function
    End If

strN = fd.SelectedItems(1)

file_picker = strN

End Function
Function double_vpr(x As String, x_ofs As Integer, x_2 As Variant, rng_where As Range, answer_ofs As Integer)

Dim single_range As Range
Dim answer As Variant

answer = 0

    For Each single_range In rng_where

        If single_range.Value = x And single_range.Offset(0, x_ofs).Value = x_2 Then
            answer = single_range.Offset(0, answer_ofs).Value
                If answer <> 0 Then
                    Exit For
                End If
        End If

    Next single_range

double_vpr = answer

End Function
Function is_exception(nom_sort As Variant) As Boolean

Dim exception_rng As Range
Dim excep1 As Range
Dim ex_answer As Boolean

    Set exception_rng = oos_ws_exception.Range(oos_ws_exception.Range("A2"), oos_ws_exception.Range("A2").End(xlDown))
    ex_answer = False

    For Each excep1 In exception_rng
        If excep1.Value = nom_sort Then
            ex_answer = True
            Exit For
        End If
    Next excep1

is_exception = ex_answer

End Function
Function split_periods(dts() As Date)

Dim ar_dmnsn As Integer
Dim dt_split As Boolean
Dim i As Integer

                If oos_days > 0 Then

                ar_dmnsn = 1

                For i = 1 To UBound(arrDates)

                    'Первая дата обрабатывается как отдельный случай.
                    'Определяется начальная размерность для массивов с начальной и конечной датами.

                    If i = 1 Then

                        ReDim oos_start(1 To ar_dmnsn)
                        ReDim oos_end(1 To ar_dmnsn)

                        oos_start(ar_dmnsn) = arrDates(i)

                    End If

                    'Если между датами промежуток более 1 дня - то делим на 2 промежутка.
                    'Увеличивая размер массивов с начальной и конечной датами.

                    If dt_split Then

                        ReDim Preserve oos_start(1 To ar_dmnsn)
                        oos_start(ar_dmnsn) = arrDates(i)
                        ReDim Preserve oos_end(1 To ar_dmnsn)

                        dt_split = False

                    End If

                    'Если период состоит из одной даты.

                    If UBound(arrDates) = 1 Then
                        ReDim oos_end(1 To ar_dmnsn)
                        oos_end(ar_dmnsn) = arrDates(i) + 1
                    End If

                    'Последняя дата в периоде.

                    If i = UBound(arrDates) Then
                        ReDim Preserve oos_end(1 To ar_dmnsn)
                        oos_end(ar_dmnsn) = arrDates(i) + 1
                        Exit For
                    End If

                    'Сравниваем даты, если они не являются соседними, то увеличиваем переменную отвечающую за размер массивов с датами.
                    'И ставим метку для разделение периода в следующей итерации цикла.

                    If arrDates(i) + 1 = arrDates(i + 1) Then

                        oos_end(ar_dmnsn) = arrDates(i + 1)

                    Else

                        oos_end(ar_dmnsn) = arrDates(i)
                        ar_dmnsn = ar_dmnsn + 1
                        dt_split = True

                    End If

                Next

                End If

End Function
Sub AccelerateExcel(status As Boolean)

Select Case status
    Case True
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Application.DisplayStatusBar = False
        Application.DisplayAlerts = False
        Application.Calculation = xlCalculationManual
    Case False
        Application.Calculation = xlCalculationAutomatic
        Application.EnableEvents = True
        Application.DisplayStatusBar = True
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True

    Case Else
        Exit Sub
    End Select

End Sub

Sub disp_status()

Application.DisplayStatusBar = True
End Sub

Attribute VB_Name = "oos_risk"
Option Explicit
Sub count_oos_risks()

Dim all_days As Integer
Dim rng_days As Range
Dim x_day As Range
Dim r As Long
Dim x_offs As Long
Dim str_zavod As String
Dim pos_id As Variant
Dim d_sales As Integer
Dim rng_search As Range
'--------------------------
Dim risk_date As Date
Dim risks_rng As Range
Dim risk_stock As Integer
'--------------------------
Dim rng_sum As Range
Dim rng_crit1 As Range
Dim rng_crit2 As Range

'Application.ScreenUpdating = False

'    Set rng_search = oos_ws_sales.Range(oos_ws_sales.Range("A4"), oos_ws_sales.Range("A4").End(xlDown))

    Set rng_sum = oos_ws_sales.Range(oos_ws_sales.Range("G4"), oos_ws_sales.Range("G4").End(xlDown))
    Set rng_crit1 = oos_ws_sales.Range(oos_ws_sales.Range("A4"), oos_ws_sales.Range("A4").End(xlDown))
    Set rng_crit2 = oos_ws_sales.Range(oos_ws_sales.Range("C4"), oos_ws_sales.Range("C4").End(xlDown))

    oos_ws_risks.Range(oos_ws_risks.Range("A2"), oos_ws_risks.Range("A2").End(xlDown)).EntireRow.Delete

    all_days = oos_ws_ost_jti.Range(oos_ws_ost_jti.Range("E2"), oos_ws_ost_jti.Range("E2").End(xlToRight)).Columns.Count
    r = oos_ws_ost_jti.Range(oos_ws_ost_jti.Range("D3"), oos_ws_ost_jti.Range("D3").End(xlDown)).rows.Count
    Set rng_days = oos_ws_ost_jti.Range(oos_ws_ost_jti.Range("E2"), oos_ws_ost_jti.Range("E2").End(xlToRight))

    For x_offs = 1 To r Step 1

        Set rng_days = rng_days.Offset(1, 0)

        str_zavod = rng_days.End(xlToLeft).Offset(0, 1).Value
        pos_id = rng_days.End(xlToLeft).Offset(0, 3).Value
        risk_date = rng_days.End(xlUp).Offset(1, 0).Value
        d_sales = Application.WorksheetFunction.SumIfs(rng_sum, rng_crit1, str_zavod, rng_crit2, pos_id)

            For Each x_day In rng_days
                    If d_sales = 0 Then
                        GoTo skip
                    End If
                risk_stock = x_day.Value / d_sales

                    If risk_stock < 3 And risk_stock > 0 Then
                            If is_exception(pos_id) Then
                                GoTo skip
                            End If

                            risk_date = x_day.End(xlUp).Offset(1, 0).Value
                            Set risks_rng = oos_ws_risks.Cells(oos_ws_risks.Cells.rows.Count, 1).End(xlUp).Offset(1, 0)
                            risks_rng.Value = str_zavod
                            risks_rng.Offset(0, 1).Value = risk_date
                            risks_rng.Offset(0, 2).Value = pos_id
                            risks_rng.Offset(0, 3).FormulaR1C1 = "=VLOOKUP(RC[-1],jti_brands,2,0)"
                            risks_rng.Offset(0, 4).FormulaR1C1 = risk_stock

                    End If
            Next x_day

skip:
    Next x_offs



'Application.ScreenUpdating = True

End Sub