---

Option Explicit

Private Const REPORT_SHEET_DASH As String = "Дашборд"
Private Const REPORT_SHEET_SUMMARY As String = "Сводка"
Private Const REPORT_SHEET_REPAIRS As String = "Ремонты"
Private Const REPORT_SHEET_REASONS As String = "Причины"
Private Const REPORT_SHEET_FILES As String = "Файлы"
Private Const REPORT_SHEET_DESNP As String = "ДЭС_НП"
Private Const REPORT_SHEET_BOILNP As String = "Котельные_НП"

Private Const SRC_SHEET_DES As String = "ДЭС"
Private Const SRC_SHEET_BOILERS As String = "Котельные"
Private Const SRC_SHEET_REPAIRS As String = "Ремонт оборудования"

' ===== ДЭС =====
Private Const DES_COL_STATE_WORK As Long = 8
Private Const DES_COL_STATE_RESERVE As Long = 9
Private Const DES_COL_STATE_REPAIR As Long = 10
Private Const DES_COL_NAME As Long = 11
Private Const DES_COL_LOAD_DAY As Long = 20
Private Const DES_COL_OIL As Long = 23
Private Const DES_COL_FUEL As Long = 25
Private Const DES_COL_OUTPUT As Long = 42

Private gDESLocality As Object
Private gBoilerLocality As Object

Public Sub ОбновитьДанные()
    Dim folderPath As String
    Dim fileName As String
    Dim fullPath As String
    Dim wb As Workbook
    Dim wsDash As Worksheet, wsSummary As Worksheet, wsRepairs As Worksheet
    Dim wsReasons As Worksheet, wsFiles As Worksheet
    Dim wsDESNP As Worksheet, wsBoilNP As Worksheet
    Dim dictSummary As Object, dictReasons As Object
    Dim repairsRow As Long, filesRow As Long
    Dim reportName As String
    Dim dt As Variant

    On Error GoTo EH

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.AskToUpdateLinks = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = "Обновление отчета..."

    folderPath = ThisWorkbook.Path
    If Len(folderPath) = 0 Then
        MsgBox "Сначала сохраните файл отчета в папку с исходными файлами.", vbExclamation
        GoTo SafeExit
    End If

    reportName = ThisWorkbook.Name

    Set dictSummary = CreateObject("Scripting.Dictionary")
    Set dictReasons = CreateObject("Scripting.Dictionary")
    Set gDESLocality = CreateObject("Scripting.Dictionary")
    Set gBoilerLocality = CreateObject("Scripting.Dictionary")

    ПодготовитьЛисты wsDash, wsSummary, wsRepairs, wsReasons, wsFiles, wsDESNP, wsBoilNP

    repairsRow = 2
    filesRow = 2

    fileName = Dir(folderPath & "\*.xls*")
    Do While fileName <> ""
        If LCase$(fileName) <> LCase$(reportName) Then
            If Left$(fileName, 2) <> "~$" Then
                fullPath = folderPath & "\" & fileName
                dt = ИзвлечьДатуИзИмениФайла(fileName)

                If IsDate(dt) Then
                    Set wb = Nothing
                    On Error Resume Next
                    Set wb = Workbooks.Open(Filename:=fullPath, ReadOnly:=True, UpdateLinks:=False, IgnoreReadOnlyRecommended:=True)
                    On Error GoTo EH

                    If Not wb Is Nothing Then
                        ОбработатьКнигу wb, CDate(dt), fileName, dictSummary, dictReasons, wsRepairs, repairsRow, wsFiles, filesRow
                        wb.Close SaveChanges:=False
                        Set wb = Nothing
                    Else
                        ЗаписатьФайл wsFiles, filesRow, fileName, CDate(dt), "Ошибка", "Не удалось открыть файл"
                        filesRow = filesRow + 1
                    End If
                Else
                    ЗаписатьФайл wsFiles, filesRow, fileName, Empty, "Пропущен", "Не найдена дата в имени файла"
                    filesRow = filesRow + 1
                End If
            End If
        End If
        fileName = Dir
    Loop

    ВыгрузитьСводку wsSummary, dictSummary
    ВыгрузитьПричины wsReasons, dictReasons
    ВыгрузитьДЭСПоНП wsDESNP, gDESLocality
    ВыгрузитьКотельныеПоНП wsBoilNP, gBoilerLocality
    ПостроитьДашборд wsDash, wsSummary, wsReasons, wsFiles, wsDESNP, wsBoilNP
    ОформитьЛисты wsSummary, wsRepairs, wsReasons, wsFiles, wsDash, wsDESNP, wsBoilNP

    MsgBox "Обновление завершено.", vbInformation

SafeExit:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.AskToUpdateLinks = True
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = False
    Exit Sub

EH:
    MsgBox "Ошибка при обновлении: " & Err.Description, vbCritical
    Resume SafeExit
End Sub

Public Sub СоздатьКнопкуОбновления()
    Dim ws As Worksheet
    Dim shp As Shape

    Set ws = ПолучитьИлиСоздатьЛист(REPORT_SHEET_DASH)

    On Error Resume Next
    ws.Shapes("btnRefresh").Delete
    On Error GoTo 0

    Set shp = ws.Shapes.AddShape(msoShapeRoundedRectangle, 700, 20, 180, 35)
    shp.Name = "btnRefresh"
    shp.TextFrame.Characters.Text = "Обновить данные"
    shp.OnAction = "ОбновитьДанные"
End Sub

Private Sub ПодготовитьЛисты(ByRef wsDash As Worksheet, ByRef wsSummary As Worksheet, ByRef wsRepairs As Worksheet, ByRef wsReasons As Worksheet, ByRef wsFiles As Worksheet, ByRef wsDESNP As Worksheet, ByRef wsBoilNP As Worksheet)
    Set wsDash = ПолучитьИлиСоздатьЛист(REPORT_SHEET_DASH)
    Set wsSummary = ПолучитьИлиСоздатьЛист(REPORT_SHEET_SUMMARY)
    Set wsRepairs = ПолучитьИлиСоздатьЛист(REPORT_SHEET_REPAIRS)
    Set wsReasons = ПолучитьИлиСоздатьЛист(REPORT_SHEET_REASONS)
    Set wsFiles = ПолучитьИлиСоздатьЛист(REPORT_SHEET_FILES)
    Set wsDESNP = ПолучитьИлиСоздатьЛист(REPORT_SHEET_DESNP)
    Set wsBoilNP = ПолучитьИлиСоздатьЛист(REPORT_SHEET_BOILNP)

    wsDash.Cells.Clear
    wsSummary.Cells.Clear
    wsRepairs.Cells.Clear
    wsReasons.Cells.Clear
    wsFiles.Cells.Clear
    wsDESNP.Cells.Clear
    wsBoilNP.Cells.Clear

    wsSummary.Range("A1:M1").Value = Array( _
        "Дата", "Файлов", "Ремонтов", "Нагрузка ДЭС, кВт", "Выработка ДЭС, кВт", _
        "Топливо ДЭС, л", "Топливо котельных, м³", "Общее топливо", _
        "ДГУ в работе", "ДГУ в резерве", "ДГУ в ремонте", "Кол-во причин", "Расход масла ДЭС")

    wsRepairs.Range("A1:F1").Value = Array("Дата", "Источник", "Объект/оборудование", "Причина", "Примечание", "Исходный файл")
    wsReasons.Range("A1:B1").Value = Array("Причина", "Количество")
    wsFiles.Range("A1:D1").Value = Array("Файл", "Дата", "Статус", "Комментарий")

    wsDESNP.Range("A1:M1").Value = Array( _
        "Дата", "Населенный пункт / организация", _
        "Нагрузка мин", "Нагрузка макс", "Нагрузка средняя", "Нагрузка сумма", _
        "Выработка", "Топливо ДЭС", "Масло ДЭС", "Кол-во установок", _
        "В работе", "В резерве", "В ремонте")

    wsBoilNP.Range("A1:F1").Value = Array( _
        "Дата", "Населенный пункт / организация", _
        "Топливо мин", "Топливо макс", "Топливо среднее", "Топливо сумма")
End Sub

Private Sub ОбработатьКнигу(ByVal wb As Workbook, ByVal dt As Date, ByVal fileName As String, ByVal dictSummary As Object, ByVal dictReasons As Object, ByVal wsRepairs As Worksheet, ByRef repairsRow As Long, ByVal wsFiles As Worksheet, ByRef filesRow As Long)
    Dim desLoad As Double
    Dim desOutput As Double
    Dim desFuel As Double
    Dim boilersFuel As Double
    Dim totalFuel As Double
    Dim desOil As Double
    Dim cntRepairs As Long
    Dim cntWork As Long, cntReserve As Long, cntRepairState As Long
    Dim okAny As Boolean

    okAny = False

    desLoad = СчитатьДЭСНагрузкуИСтатусыИНП(wb, dt, cntWork, cntReserve, cntRepairState)
    desOutput = СчитатьВыработкуДЭСИОбновитьНП(wb, dt)
    desFuel = СчитатьТопливоДЭСИОбновитьНП(wb, dt)
    desOil = СчитатьМаслоДЭСИОбновитьНП(wb, dt)
    boilersFuel = СчитатьТопливоКотельныхИНП(wb, dt)
    totalFuel = desFuel + boilersFuel
    cntRepairs = СчитатьРемонты(wb, dt, fileName, dictReasons, wsRepairs, repairsRow)

    If desLoad <> 0 Or desOutput <> 0 Or desFuel <> 0 Or boilersFuel <> 0 Or desOil <> 0 Then okAny = True
    If cntWork <> 0 Or cntReserve <> 0 Or cntRepairState <> 0 Then okAny = True
    If cntRepairs <> 0 Then okAny = True

    ДобавитьВСводку dictSummary, dt, 1, cntRepairs, desLoad, desOutput, desFuel, boilersFuel, totalFuel, cntWork, cntReserve, cntRepairState, desOil

    If okAny Then
        ЗаписатьФайл wsFiles, filesRow, fileName, dt, "ОК", "Обработан"
    Else
        ЗаписатьФайл wsFiles, filesRow, fileName, dt, "ОК", "Файл открыт, но данные не распознаны"
    End If

    filesRow = filesRow + 1
End Sub

Private Function СчитатьДЭСНагрузкуИСтатусыИНП(ByVal wb As Workbook, ByVal dt As Date, ByRef cntWork As Long, ByRef cntReserve As Long, ByRef cntRepairState As Long) As Double
    Dim ws As Worksheet
    Dim lastRow As Long, r As Long
    Dim totalLoad As Double
    Dim vRun As Variant, vReserve As Variant, vRepair As Variant, vLoad As Variant
    Dim np As String
    Dim stWork As Long, stReserve As Long, stRepair As Long

    On Error Resume Next
    Set ws = wb.Worksheets(SRC_SHEET_DES)
    On Error GoTo 0
    If ws Is Nothing Then Exit Function

    lastRow = ПоследняяСтрока(ws)
    totalLoad = 0
    np = ""

    For r = 1 To lastRow
        If ЭтоЗаголовокБлокаДЭС(ws, r) Then
            np = ИзвлечьИмяБлокаДЭС(ws, r)
        ElseIf ЭтоСтрокаДЭС(ws, r) Then
            vRun = ws.Cells(r, DES_COL_STATE_WORK).Value
            vReserve = ws.Cells(r, DES_COL_STATE_RESERVE).Value
            vRepair = ws.Cells(r, DES_COL_STATE_REPAIR).Value
            vLoad = ws.Cells(r, DES_COL_LOAD_DAY).Value

            stWork = 0: stReserve = 0: stRepair = 0

            If Trim$(CStr(vRun)) = "+" Then
                cntWork = cntWork + 1
                stWork = 1
            End If

            If Trim$(CStr(vReserve)) = "+" Then
                cntReserve = cntReserve + 1
                stReserve = 1
            End If

            If LCase$(Trim$(CStr(vRepair))) = "ремонт" Or Trim$(CStr(vRepair)) = "+" Then
                cntRepairState = cntRepairState + 1
                stRepair = 1
            End If

            totalLoad = totalLoad + ЧислоИзЯчейки(vLoad)
            ОбновитьДЭСНП dt, np, ЧислоИзЯчейки(vLoad), 0, 0, 0, stWork, stReserve, stRepair
        End If
    Next r

    СчитатьДЭСНагрузкуИСтатусыИНП = totalLoad
End Function

Private Function СчитатьВыработкуДЭСИОбновитьНП(ByVal wb As Workbook, ByVal dt As Date) As Double
    Dim ws As Worksheet
    Dim lastRow As Long, r As Long
    Dim totalOutput As Double
    Dim v As Variant, np As String

    On Error Resume Next
    Set ws = wb.Worksheets(SRC_SHEET_DES)
    On Error GoTo 0
    If ws Is Nothing Then Exit Function

    lastRow = ПоследняяСтрока(ws)
    totalOutput = 0
    np = ""

    For r = 1 To lastRow
        If ЭтоЗаголовокБлокаДЭС(ws, r) Then
            np = ИзвлечьИмяБлокаДЭС(ws, r)
        ElseIf ЭтоСтрокаДЭС(ws, r) Then
            v = ws.Cells(r, DES_COL_OUTPUT).Value
            totalOutput = totalOutput + ЧислоИзЯчейки(v)
            ОбновитьДЭСНП dt, np, 0, ЧислоИзЯчейки(v), 0, 0
        End If
    Next r

    СчитатьВыработкуДЭСИОбновитьНП = totalOutput
End Function

Private Function СчитатьТопливоДЭСИОбновитьНП(ByVal wb As Workbook, ByVal dt As Date) As Double
    Dim ws As Worksheet
    Dim lastRow As Long, r As Long
    Dim totalFuel As Double
    Dim v As Variant, np As String

    On Error Resume Next
    Set ws = wb.Worksheets(SRC_SHEET_DES)
    On Error GoTo 0
    If ws Is Nothing Then Exit Function

    lastRow = ПоследняяСтрока(ws)
    totalFuel = 0
    np = ""

    For r = 1 To lastRow
        If ЭтоЗаголовокБлокаДЭС(ws, r) Then
            np = ИзвлечьИмяБлокаДЭС(ws, r)
        ElseIf ЭтоСтрокаДЭС(ws, r) Then
            v = ws.Cells(r, DES_COL_FUEL).Value
            totalFuel = totalFuel + ЧислоИзЯчейки(v)
            ОбновитьДЭСНП dt, np, 0, 0, ЧислоИзЯчейки(v), 0
        End If
    Next r

    СчитатьТопливоДЭСИОбновитьНП = totalFuel
End Function

Private Function СчитатьМаслоДЭСИОбновитьНП(ByVal wb As Workbook, ByVal dt As Date) As Double
    Dim ws As Worksheet
    Dim lastRow As Long, r As Long
    Dim totalOil As Double
    Dim v As Variant, np As String

    On Error Resume Next
    Set ws = wb.Worksheets(SRC_SHEET_DES)
    On Error GoTo 0
    If ws Is Nothing Then Exit Function

    lastRow = ПоследняяСтрока(ws)
    totalOil = 0
    np = ""

    For r = 1 To lastRow
        If ЭтоЗаголовокБлокаДЭС(ws, r) Then
            np = ИзвлечьИмяБлокаДЭС(ws, r)
        ElseIf ЭтоСтрокаДЭС(ws, r) Then
            v = ws.Cells(r, DES_COL_OIL).Value
            totalOil = totalOil + ЧислоИзЯчейки(v)
            ОбновитьДЭСНП dt, np, 0, 0, 0, ЧислоИзЯчейки(v)
        End If
    Next r

    СчитатьМаслоДЭСИОбновитьНП = totalOil
End Function

Private Function СчитатьТопливоКотельныхИНП(ByVal wb As Workbook, ByVal dt As Date) As Double
    Dim ws As Worksheet
    Dim lastRow As Long, r As Long
    Dim totalFuel As Double
    Dim fuelCol As Long
    Dim v As Variant, np As String

    On Error Resume Next
    Set ws = wb.Worksheets(SRC_SHEET_BOILERS)
    On Error GoTo 0
    If ws Is Nothing Then Exit Function

    fuelCol = НайтиКолонкуТопливаКотельных(ws)
    lastRow = ПоследняяСтрока(ws)
    totalFuel = 0
    np = ""

    For r = 1 To lastRow
        If ЭтоЗаголовокБлокаКотельной(ws, r) Then
            np = ИзвлечьИмяБлокаКотельной(ws, r)
        ElseIf ЭтоСтрокаКотельной(ws, r) Then
            v = ws.Cells(r, fuelCol).Value
            totalFuel = totalFuel + ЧислоИзЯчейки(v)
            ОбновитьКотельныеНП dt, np, ЧислоИзЯчейки(v)
        End If
    Next r

    СчитатьТопливоКотельныхИНП = totalFuel
End Function

Private Function СчитатьРемонты(ByVal wb As Workbook, ByVal dt As Date, ByVal fileName As String, ByVal dictReasons As Object, ByVal wsRepairs As Worksheet, ByRef repairsRow As Long) As Long
    Dim ws As Worksheet
    Dim lastRow As Long, r As Long
    Dim unitNo As Variant
    Dim typeVal As String, engineVal As String
    Dim reasonVal As String, noteVal As String
    Dim cnt As Long

    On Error Resume Next
    Set ws = wb.Worksheets(SRC_SHEET_REPAIRS)
    On Error GoTo 0
    If ws Is Nothing Then Exit Function

    lastRow = ПоследняяСтрока(ws)
    cnt = 0

    For r = 3 To lastRow
        unitNo = ws.Cells(r, 2).Value
        typeVal = Trim$(CStr(ws.Cells(r, 3).Value))
        engineVal = Trim$(CStr(ws.Cells(r, 4).Value))
        reasonVal = Trim$(CStr(ws.Cells(r, 6).Value))
        noteVal = Trim$(CStr(ws.Cells(r, 8).Value))

        If reasonVal <> "" And IsNumeric(unitNo) Then
            wsRepairs.Cells(repairsRow, 1).Value = dt
            wsRepairs.Cells(repairsRow, 2).Value = "Ремонт оборудования"
            wsRepairs.Cells(repairsRow, 3).Value = Trim$(typeVal & " " & engineVal)
            wsRepairs.Cells(repairsRow, 4).Value = reasonVal
            wsRepairs.Cells(repairsRow, 5).Value = noteVal
            wsRepairs.Cells(repairsRow, 6).Value = fileName

            repairsRow = repairsRow + 1
            cnt = cnt + 1

            If dictReasons.Exists(reasonVal) Then
                dictReasons(reasonVal) = CLng(dictReasons(reasonVal)) + 1
            Else
                dictReasons.Add reasonVal, 1
            End If
        End If
    Next r

    СчитатьРемонты = cnt
End Function

Private Sub ДобавитьВСводку(ByVal dictSummary As Object, ByVal dt As Date, ByVal fileCount As Long, ByVal repairCount As Long, ByVal desLoad As Double, ByVal desOutput As Double, ByVal desFuel As Double, ByVal boilersFuel As Double, ByVal totalFuel As Double, ByVal workCnt As Long, ByVal reserveCnt As Long, ByVal repairStateCnt As Long, ByVal desOil As Double)
    Dim key As String
    Dim arr As Variant

    key = Format$(dt, "yyyy-mm-dd")

    If dictSummary.Exists(key) Then
        arr = dictSummary(key)
    Else
        ReDim arr(1 To 12)
        arr(1) = 0
        arr(2) = 0
        arr(3) = 0#
        arr(4) = 0#
        arr(5) = 0#
        arr(6) = 0#
        arr(7) = 0#
        arr(8) = 0
        arr(9) = 0
        arr(10) = 0
        arr(11) = 0
        arr(12) = 0#
    End If

    arr(1) = arr(1) + fileCount
    arr(2) = arr(2) + repairCount
    arr(3) = arr(3) + desLoad
    arr(4) = arr(4) + desOutput
    arr(5) = arr(5) + desFuel
    arr(6) = arr(6) + boilersFuel
    arr(7) = arr(7) + totalFuel
    arr(8) = arr(8) + workCnt
    arr(9) = arr(9) + reserveCnt
    arr(10) = arr(10) + repairStateCnt
    arr(11) = arr(11) + 0
    arr(12) = arr(12) + desOil

    dictSummary(key) = arr
End Sub

Private Sub ВыгрузитьСводку(ByVal ws As Worksheet, ByVal dictSummary As Object)
    Dim keys As Variant, i As Long, r As Long, arr As Variant

    If dictSummary.Count = 0 Then Exit Sub

    keys = dictSummary.Keys
    ОтсортироватьДаты keys

    r = 2
    For i = LBound(keys) To UBound(keys)
        arr = dictSummary(keys(i))
        ws.Cells(r, 1).Value = CDate(keys(i))
        ws.Cells(r, 2).Value = arr(1)
        ws.Cells(r, 3).Value = arr(2)
        ws.Cells(r, 4).Value = arr(3)
        ws.Cells(r, 5).Value = arr(4)
        ws.Cells(r, 6).Value = arr(5)
        ws.Cells(r, 7).Value = arr(6)
        ws.Cells(r, 8).Value = arr(7)
        ws.Cells(r, 9).Value = arr(8)
        ws.Cells(r, 10).Value = arr(9)
        ws.Cells(r, 11).Value = arr(10)
        ws.Cells(r, 12).Formula = "=COUNTIF(Ремонты!A:A,A" & r & ")"
        ws.Cells(r, 13).Value = arr(12)
        r = r + 1
    Next i
End Sub

Private Sub ВыгрузитьПричины(ByVal ws As Worksheet, ByVal dictReasons As Object)
    Dim keys As Variant, i As Long, r As Long
    Dim lastRow As Long

    If dictReasons.Count = 0 Then Exit Sub

    keys = dictReasons.Keys
    r = 2

    For i = LBound(keys) To UBound(keys)
        ws.Cells(r, 1).Value = keys(i)
        ws.Cells(r, 2).Value = dictReasons(keys(i))
        r = r + 1
    Next i

    lastRow = ПоследняяСтрока(ws)
    If lastRow >= 2 Then
        ws.Range("A1:B" & lastRow).Sort Key1:=ws.Range("B2"), Order1:=xlDescending, Header:=xlYes
    End If
End Sub

Private Sub ВыгрузитьДЭСПоНП(ByVal ws As Worksheet, ByVal dictData As Object)
    Dim keys As Variant, i As Long, r As Long, arr As Variant, parts() As String
    Dim avgLoad As Double

    If dictData Is Nothing Then Exit Sub
    If dictData.Count = 0 Then Exit Sub

    keys = dictData.Keys
    ОтсортироватьСтроки keys

    r = 2
    For i = LBound(keys) To UBound(keys)
        arr = dictData(keys(i))
        parts = Split(CStr(keys(i)), "|")

        avgLoad = 0
        If arr(7) > 0 Then avgLoad = arr(3) / arr(7)

        ws.Cells(r, 1).Value = CDate(parts(0))
        ws.Cells(r, 2).Value = parts(1)
        ws.Cells(r, 3).Value = arr(1)
        ws.Cells(r, 4).Value = arr(2)
        ws.Cells(r, 5).Value = avgLoad
        ws.Cells(r, 6).Value = arr(3)
        ws.Cells(r, 7).Value = arr(4)
        ws.Cells(r, 8).Value = arr(5)
        ws.Cells(r, 9).Value = arr(6)
        ws.Cells(r, 10).Value = arr(7)
        ws.Cells(r, 11).Value = arr(8)
        ws.Cells(r, 12).Value = arr(9)
        ws.Cells(r, 13).Value = arr(10)
        r = r + 1
    Next i
End Sub

Private Sub ВыгрузитьКотельныеПоНП(ByVal ws As Worksheet, ByVal dictData As Object)
    Dim keys As Variant, i As Long, r As Long, arr As Variant, parts() As String
    Dim avgFuel As Double

    If dictData Is Nothing Then Exit Sub
    If dictData.Count = 0 Then Exit Sub

    keys = dictData.Keys
    ОтсортироватьСтроки keys

    r = 2
    For i = LBound(keys) To UBound(keys)
        arr = dictData(keys(i))
        parts = Split(CStr(keys(i)), "|")

        avgFuel = 0
        If arr(4) > 0 Then avgFuel = arr(3) / arr(4)

        ws.Cells(r, 1).Value = CDate(parts(0))
        ws.Cells(r, 2).Value = parts(1)
        ws.Cells(r, 3).Value = arr(1)
        ws.Cells(r, 4).Value = arr(2)
        ws.Cells(r, 5).Value = avgFuel
        ws.Cells(r, 6).Value = arr(3)
        r = r + 1
    Next i
End Sub

Private Sub ПостроитьДашборд(ByVal wsDash As Worksheet, ByVal wsSummary As Worksheet, ByVal wsReasons As Worksheet, ByVal wsFiles As Worksheet, ByVal wsDESNP As Worksheet, ByVal wsBoilNP As Worksheet)
    Dim lastSummaryRow As Long, lastReasonsRow As Long, lastDESNPRow As Long, lastBoilNPRow As Long
    Dim ch As ChartObject

    wsDash.Cells.Clear

    wsDash.Range("A1").Value = "Месячный дашборд"
    wsDash.Range("A1").Font.Size = 18
    wsDash.Range("A1").Font.Bold = True

    wsDash.Range("A3").Value = "Файлов обработано"
    wsDash.Range("B3").Formula = "=MAX(0,COUNTA(Файлы!A:A)-1)"

    wsDash.Range("D3").Value = "Дней с данными"
    wsDash.Range("E3").Formula = "=MAX(0,COUNTA(Сводка!A:A)-1)"

    wsDash.Range("A4").Value = "Всего ремонтов"
    wsDash.Range("B4").Formula = "=SUM(Сводка!C:C)"

    wsDash.Range("D4").Value = "Выработка ДЭС"
    wsDash.Range("E4").Formula = "=SUM(Сводка!E:E)"

    wsDash.Range("A5").Value = "Топливо ДЭС"
    wsDash.Range("B5").Formula = "=SUM(Сводка!F:F)"

    wsDash.Range("D5").Value = "Топливо котельных"
    wsDash.Range("E5").Formula = "=SUM(Сводка!G:G)"

    wsDash.Range("A6").Value = "Общее топливо"
    wsDash.Range("B6").Formula = "=SUM(Сводка!H:H)"

    wsDash.Range("D6").Value = "Нагрузка ДЭС"
    wsDash.Range("E6").Formula = "=SUM(Сводка!D:D)"

    wsDash.Range("A7").Value = "Расход масла ДЭС"
    wsDash.Range("B7").Formula = "=SUM(Сводка!M:M)"

    wsDash.Range("D7").Value = "Последняя дата"
    wsDash.Range("E7").Formula = "=MAX(Сводка!A:A)"
    wsDash.Range("E7").NumberFormat = "dd.mm.yyyy"

    lastSummaryRow = ПоследняяСтрока(wsSummary)
    lastReasonsRow = ПоследняяСтрока(wsReasons)
    lastDESNPRow = ПоследняяСтрока(wsDESNP)
    lastBoilNPRow = ПоследняяСтрока(wsBoilNP)

    УдалитьВсеДиаграммы wsDash
    wsDash.Range("J:O").Clear

    If lastSummaryRow >= 2 Then
        Set ch = wsDash.ChartObjects.Add(Left:=20, Top:=130, Width:=420, Height:=220)
        With ch.Chart
            .ChartType = xlColumnClustered
            ОчиститьСерии ch.Chart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Name = "=""Ремонты"""
            .SeriesCollection(1).XValues = wsSummary.Range("A2:A" & lastSummaryRow)
            .SeriesCollection(1).Values = wsSummary.Range("C2:C" & lastSummaryRow)
            .HasTitle = True
            .ChartTitle.Text = "Ремонты по дням"
        End With

        Set ch = wsDash.ChartObjects.Add(Left:=460, Top:=130, Width:=420, Height:=220)
        With ch.Chart
            .ChartType = xlLine
            ОчиститьСерии ch.Chart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Name = "=""Общее топливо"""
            .SeriesCollection(1).XValues = wsSummary.Range("A2:A" & lastSummaryRow)
            .SeriesCollection(1).Values = wsSummary.Range("H2:H" & lastSummaryRow)
            .HasTitle = True
            .ChartTitle.Text = "Общее топливо по дням"
        End With
    End If

    If lastDESNPRow >= 2 Then
        СводАгрегатДЭСПоБлокам wsDESNP, wsDash

        Set ch = wsDash.ChartObjects.Add(Left:=20, Top:=380, Width:=860, Height:=260)
        With ch.Chart
            .ChartType = xlColumnClustered
            ОчиститьСерии ch.Chart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Name = "=""Мин"""
            .SeriesCollection(1).XValues = wsDash.Range("J3:J" & ПоследняяСтрока(wsDash))
            .SeriesCollection(1).Values = wsDash.Range("K3:K" & ПоследняяСтрока(wsDash))
            .SeriesCollection.NewSeries
            .SeriesCollection(2).Name = "=""Сред"""
            .SeriesCollection(2).XValues = wsDash.Range("J3:J" & ПоследняяСтрока(wsDash))
            .SeriesCollection(2).Values = wsDash.Range("L3:L" & ПоследняяСтрока(wsDash))
            .SeriesCollection.NewSeries
            .SeriesCollection(3).Name = "=""Макс"""
            .SeriesCollection(3).XValues = wsDash.Range("J3:J" & ПоследняяСтрока(wsDash))
            .SeriesCollection(3).Values = wsDash.Range("M3:M" & ПоследняяСтрока(wsDash))
            .HasTitle = True
            .ChartTitle.Text = "Мин / сред / макс нагрузки ДЭС по блокам"
        End With

        Set ch = wsDash.ChartObjects.Add(Left:=20, Top:=670, Width:=420, Height:=260)
        With ch.Chart
            .ChartType = xlBarClustered
            ОчиститьСерии ch.Chart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Name = "=""Выработка"""
            .SeriesCollection(1).XValues = wsDash.Range("J3:J" & ПоследняяСтрока(wsDash))
            .SeriesCollection(1).Values = wsDash.Range("N3:N" & ПоследняяСтрока(wsDash))
            .HasTitle = True
            .ChartTitle.Text = "Выработка ДЭС по блокам"
        End With

        Set ch = wsDash.ChartObjects.Add(Left:=460, Top:=670, Width:=420, Height:=260)
        With ch.Chart
            .ChartType = xlBarClustered
            ОчиститьСерии ch.Chart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Name = "=""Топливо ДЭС"""
            .SeriesCollection(1).XValues = wsDash.Range("J3:J" & ПоследняяСтрока(wsDash))
            .SeriesCollection(1).Values = wsDash.Range("O3:O" & ПоследняяСтрока(wsDash))
            .HasTitle = True
            .ChartTitle.Text = "Топливо ДЭС по блокам"
        End With
    End If

    If lastBoilNPRow >= 2 Then
        СводАгрегатКотельныхПоБлокам wsBoilNP, wsDash

        Set ch = wsDash.ChartObjects.Add(Left:=20, Top:=960, Width:=860, Height:=260)
        With ch.Chart
            .ChartType = xlColumnClustered
            ОчиститьСерии ch.Chart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Name = "=""Мин"""
            .SeriesCollection(1).XValues = wsDash.Range("J41:J" & ПоследняяСтрока(wsDash))
            .SeriesCollection(1).Values = wsDash.Range("K41:K" & ПоследняяСтрока(wsDash))
            .SeriesCollection.NewSeries
            .SeriesCollection(2).Name = "=""Сред"""
            .SeriesCollection(2).XValues = wsDash.Range("J41:J" & ПоследняяСтрока(wsDash))
            .SeriesCollection(2).Values = wsDash.Range("L41:L" & ПоследняяСтрока(wsDash))
            .SeriesCollection.NewSeries
            .SeriesCollection(3).Name = "=""Макс"""
            .SeriesCollection(3).XValues = wsDash.Range("J41:J" & ПоследняяСтрока(wsDash))
            .SeriesCollection(3).Values = wsDash.Range("M41:M" & ПоследняяСтрока(wsDash))
            .HasTitle = True
            .ChartTitle.Text = "Мин / сред / макс топлива котельных по блокам"
        End With

        Set ch = wsDash.ChartObjects.Add(Left:=20, Top:=1250, Width:=860, Height:=260)
        With ch.Chart
            .ChartType = xlBarClustered
            ОчиститьСерии ch.Chart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Name = "=""Сумма"""
            .SeriesCollection(1).XValues = wsDash.Range("J41:J" & ПоследняяСтрока(wsDash))
            .SeriesCollection(1).Values = wsDash.Range("N41:N" & ПоследняяСтрока(wsDash))
            .HasTitle = True
            .ChartTitle.Text = "Топливо котельных по блокам"
        End With
    End If

    If lastReasonsRow >= 2 Then
        Set ch = wsDash.ChartObjects.Add(Left:=20, Top:=1540, Width:=860, Height:=260)
        With ch.Chart
            .ChartType = xlBarClustered
            ОчиститьСерии ch.Chart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Name = "=""Причины"""
            .SeriesCollection(1).XValues = wsReasons.Range("A2:A" & WorksheetFunction.Min(lastReasonsRow, 11))
            .SeriesCollection(1).Values = wsReasons.Range("B2:B" & WorksheetFunction.Min(lastReasonsRow, 11))
            .HasTitle = True
            .ChartTitle.Text = "Топ причин ремонтов"
        End With
    End If
End Sub

Private Sub СводАгрегатДЭСПоБлокам(ByVal wsSrc As Worksheet, ByVal wsDash As Worksheet)
    Dim dict As Object, r As Long, lastRow As Long, np As String
    Dim arr As Variant, outRow As Long, keys As Variant, i As Long
    Dim mn As Double, mx As Double, avgV As Double, sumOutput As Double, sumFuel As Double

    Set dict = CreateObject("Scripting.Dictionary")
    lastRow = ПоследняяСтрока(wsSrc)

    wsDash.Range("J2:O200").Clear
    wsDash.Range("J2:O2").Value = Array("Блок", "Мин", "Сред", "Макс", "Выработка", "Топливо ДЭС")

    For r = 2 To lastRow
        np = Trim$(CStr(wsSrc.Cells(r, 2).Value))
        If np <> "" Then
            mn = ЧислоИзЯчейки(wsSrc.Cells(r, 3).Value)
            mx = ЧислоИзЯчейки(wsSrc.Cells(r, 4).Value)
            avgV = ЧислоИзЯчейки(wsSrc.Cells(r, 5).Value)
            sumOutput = ЧислоИзЯчейки(wsSrc.Cells(r, 7).Value)
            sumFuel = ЧислоИзЯчейки(wsSrc.Cells(r, 8).Value)

            If dict.Exists(np) Then
                arr = dict(np)
                If mn < arr(1) Or arr(1) = 0 Then arr(1) = mn
                If mx > arr(3) Then arr(3) = mx
                arr(2) = arr(2) + avgV
                arr(4) = arr(4) + sumOutput
                arr(5) = arr(5) + sumFuel
                arr(6) = arr(6) + 1
            Else
                ReDim arr(1 To 6)
                arr(1) = mn
                arr(2) = avgV
                arr(3) = mx
                arr(4) = sumOutput
                arr(5) = sumFuel
                arr(6) = 1
            End If
            dict(np) = arr
        End If
    Next r

    keys = dict.Keys
    ОтсортироватьСтроки keys

    outRow = 3
    For i = LBound(keys) To UBound(keys)
        arr = dict(keys(i))
        wsDash.Cells(outRow, 10).Value = keys(i)
        wsDash.Cells(outRow, 11).Value = arr(1)
        wsDash.Cells(outRow, 12).Value = arr(2) / arr(6)
        wsDash.Cells(outRow, 13).Value = arr(3)
        wsDash.Cells(outRow, 14).Value = arr(4)
        wsDash.Cells(outRow, 15).Value = arr(5)
        outRow = outRow + 1
    Next i
End Sub

Private Sub СводАгрегатКотельныхПоБлокам(ByVal wsSrc As Worksheet, ByVal wsDash As Worksheet)
    Dim dict As Object, r As Long, lastRow As Long, np As String
    Dim arr As Variant, outRow As Long, keys As Variant, i As Long
    Dim mn As Double, mx As Double, avgV As Double, sumV As Double

    Set dict = CreateObject("Scripting.Dictionary")
    lastRow = ПоследняяСтрока(wsSrc)

    wsDash.Range("J40:N250").Clear
    wsDash.Range("J40:N40").Value = Array("Блок", "Мин", "Сред", "Макс", "Сумма")

    For r = 2 To lastRow
        np = Trim$(CStr(wsSrc.Cells(r, 2).Value))
        If np <> "" Then
            mn = ЧислоИзЯчейки(wsSrc.Cells(r, 3).Value)
            mx = ЧислоИзЯчейки(wsSrc.Cells(r, 4).Value)
            avgV = ЧислоИзЯчейки(wsSrc.Cells(r, 5).Value)
            sumV = ЧислоИзЯчейки(wsSrc.Cells(r, 6).Value)

            If dict.Exists(np) Then
                arr = dict(np)
                If mn < arr(1) Or arr(1) = 0 Then arr(1) = mn
                If mx > arr(3) Then arr(3) = mx
                arr(2) = arr(2) + avgV
                arr(4) = arr(4) + sumV
                arr(5) = arr(5) + 1
            Else
                ReDim arr(1 To 5)
                arr(1) = mn
                arr(2) = avgV
                arr(3) = mx
                arr(4) = sumV
                arr(5) = 1
            End If
            dict(np) = arr
        End If
    Next r

    keys = dict.Keys
    ОтсортироватьСтроки keys

    outRow = 41
    For i = LBound(keys) To UBound(keys)
        arr = dict(keys(i))
        wsDash.Cells(outRow, 10).Value = keys(i)
        wsDash.Cells(outRow, 11).Value = arr(1)
        wsDash.Cells(outRow, 12).Value = arr(2) / arr(5)
        wsDash.Cells(outRow, 13).Value = arr(3)
        wsDash.Cells(outRow, 14).Value = arr(4)
        outRow = outRow + 1
    Next i
End Sub

Private Sub ОформитьЛисты(ByVal wsSummary As Worksheet, ByVal wsRepairs As Worksheet, ByVal wsReasons As Worksheet, ByVal wsFiles As Worksheet, ByVal wsDash As Worksheet, ByVal wsDESNP As Worksheet, ByVal wsBoilNP As Worksheet)
    ОформитьОдинЛист wsSummary
    ОформитьОдинЛист wsRepairs
    ОформитьОдинЛист wsReasons
    ОформитьОдинЛист wsFiles
    ОформитьОдинЛист wsDESNP
    ОформитьОдинЛист wsBoilNP

    wsSummary.Columns("A").NumberFormat = "dd.mm.yyyy"
    wsRepairs.Columns("A").NumberFormat = "dd.mm.yyyy"
    wsFiles.Columns("B").NumberFormat = "dd.mm.yyyy"
    wsDESNP.Columns("A").NumberFormat = "dd.mm.yyyy"
    wsBoilNP.Columns("A").NumberFormat = "dd.mm.yyyy"

    wsDash.Columns("A:F").ColumnWidth = 16
    wsDash.Columns("J:O").EntireColumn.AutoFit
    wsDash.Range("A3:E7").Font.Bold = True
End Sub

Private Sub ОформитьОдинЛист(ByVal ws As Worksheet)
    With ws.Rows(1)
        .Font.Bold = True
        .Interior.Color = RGB(217, 225, 242)
    End With

    ws.Cells.EntireColumn.AutoFit

    On Error Resume Next
    ws.Rows(1).AutoFilter
    On Error GoTo 0
End Sub

Private Sub ЗаписатьФайл(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal fileName As String, ByVal dt As Variant, ByVal statusText As String, ByVal commentText As String)
    ws.Cells(rowNum, 1).Value = fileName
    If IsDate(dt) Then ws.Cells(rowNum, 2).Value = CDate(dt)
    ws.Cells(rowNum, 3).Value = statusText
    ws.Cells(rowNum, 4).Value = commentText
End Sub

Private Function ПолучитьИлиСоздатьЛист(ByVal sheetName As String) As Worksheet
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If LCase$(ws.Name) = LCase$(sheetName) Then
            Set ПолучитьИлиСоздатьЛист = ws
            Exit Function
        End If
    Next ws

    Set ws = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
    ws.Name = Left$(sheetName, 31)
    Set ПолучитьИлиСоздатьЛист = ws
End Function

Private Function ИзвлечьДатуИзИмениФайла(ByVal fileName As String) As Variant
    Dim re As Object, m As Object
    Dim d As Integer, mn As Integer, y As Integer

    Set re = CreateObject("VBScript.RegExp")
    re.Global = False
    re.IgnoreCase = True
    re.Pattern = "(\d{1,2})[.\-_](\d{1,2})[.\-_](\d{4})"

    If re.Test(fileName) Then
        Set m = re.Execute(fileName)(0)
        d = CInt(m.SubMatches(0))
        mn = CInt(m.SubMatches(1))
        y = CInt(m.SubMatches(2))
        ИзвлечьДатуИзИмениФайла = DateSerial(y, mn, d)
    Else
        ИзвлечьДатуИзИмениФайла = Empty
    End If
End Function

Private Function ПоследняяСтрока(ByVal ws As Worksheet) As Long
    Dim f As Range
    On Error Resume Next
    Set f = ws.Cells.Find(What:="*", After:=ws.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    On Error GoTo 0
    If f Is Nothing Then
        ПоследняяСтрока = 1
    Else
        ПоследняяСтрока = f.Row
    End If
End Function

Private Function ЧислоИзЯчейки(ByVal v As Variant) As Double
    Dim s As String

    If IsNumeric(v) Then
        ЧислоИзЯчейки = CDbl(v)
        Exit Function
    End If

    s = Trim$(CStr(v))
    If s = "" Or s = "-" Then Exit Function

    s = Replace(s, Chr(160), "")
    s = Replace(s, " ", "")
    s = Replace(s, "кВт", "", , , vbTextCompare)
    s = Replace(s, "квт", "", , , vbTextCompare)
    s = Replace(s, "л.", "", , , vbTextCompare)
    s = Replace(s, "л", "", , , vbTextCompare)
    s = Replace(s, "м³", "", , , vbTextCompare)
    s = Replace(s, "м3", "", , , vbTextCompare)
    s = Replace(s, ",", ".")

    If IsNumeric(s) Then
        ЧислоИзЯчейки = CDbl(s)
    End If
End Function

Private Function ЭтоСтрокаДЭС(ByVal ws As Worksheet, ByVal r As Long) As Boolean
    Dim nm As String
    nm = Trim$(CStr(ws.Cells(r, DES_COL_NAME).Value))
    If nm = "" Then Exit Function
    If LCase$(nm) Like "*итого*" Then Exit Function
    If LCase$(nm) Like "*фидер*" Then Exit Function
    If LCase$(nm) Like "*номер*" Then Exit Function
    If LCase$(nm) Like "*собствен*" Then Exit Function

    If InStr(1, nm, "Ф-", vbTextCompare) > 0 _
       Or InStr(1, nm, "ДГУ-", vbTextCompare) > 0 _
       Or InStr(1, nm, "ГТУ-", vbTextCompare) > 0 _
       Or InStr(1, nm, "РДГУ-", vbTextCompare) > 0 _
       Or InStr(1, nm, "ГПА-", vbTextCompare) > 0 Then
        ЭтоСтрокаДЭС = True
    End If
End Function

Private Function ЭтоЗаголовокБлокаДЭС(ByVal ws As Worksheet, ByVal r As Long) As Boolean
    Dim txt As String
    txt = ТекстСтроки(ws, r)
    If txt = "" Then Exit Function

    If InStr(1, txt, "ДЭС-", vbTextCompare) > 0 Then ЭтоЗаголовокБлокаДЭС = True: Exit Function
    If InStr(1, txt, "ГПТЭС", vbTextCompare) > 0 Then ЭтоЗаголовокБлокаДЭС = True: Exit Function
    If InStr(1, txt, "ГПЭС", vbTextCompare) > 0 Then ЭтоЗаголовокБлокаДЭС = True: Exit Function
    If InStr(1, txt, "ООО", vbTextCompare) > 0 Then ЭтоЗаголовокБлокаДЭС = True: Exit Function
    If InStr(1, txt, "АО", vbTextCompare) > 0 Then ЭтоЗаголовокБлокаДЭС = True: Exit Function
    If InStr(1, txt, " ул.", vbTextCompare) > 0 Then ЭтоЗаголовокБлокаДЭС = True: Exit Function
End Function

Private Function ЭтоЗаголовокБлокаКотельной(ByVal ws As Worksheet, ByVal r As Long) As Boolean
    Dim txt As String
    txt = ТекстСтроки(ws, r)
    If txt = "" Then Exit Function

    If InStr(1, txt, "№", vbTextCompare) > 0 And InStr(1, txt, "ул.", vbTextCompare) > 0 Then
        ЭтоЗаголовокБлокаКотельной = True
        Exit Function
    End If

    If InStr(1, txt, "ООО", vbTextCompare) > 0 Then ЭтоЗаголовокБлокаКотельной = True: Exit Function
    If InStr(1, txt, "АО", vbTextCompare) > 0 Then ЭтоЗаголовокБлокаКотельной = True: Exit Function
End Function

Private Function ЭтоСтрокаКотельной(ByVal ws As Worksheet, ByVal r As Long) As Boolean
    Dim txt As String
    txt = ТекстСтроки(ws, r)
    If txt = "" Then Exit Function
    If InStr(1, txt, "ул.", vbTextCompare) > 0 Then Exit Function
    If InStr(1, LCase$(txt), "итого", vbTextCompare) > 0 Then Exit Function
    If WorksheetFunction.CountA(ws.Rows(r)) > 3 Then ЭтоСтрокаКотельной = True
End Function

Private Function НайтиКолонкуТопливаКотельных(ByVal ws As Worksheet) As Long
    Dim r As Long, c As Long, lastCol As Long
    Dim txt As String

    For r = 1 To 12
        lastCol = ws.Cells(r, ws.Columns.Count).End(xlToLeft).Column
        For c = 1 To lastCol
            txt = LCase$(Trim$(CStr(ws.Cells(r, c).Value)))
            If txt <> "" Then
                If InStr(txt, "расход") > 0 And InStr(txt, "топлив") > 0 And InStr(txt, "сутк") > 0 Then
                    НайтиКолонкуТопливаКотельных = c
                    Exit Function
                End If
            End If
        Next c
    Next r

    НайтиКолонкуТопливаКотельных = 20
End Function

Private Function ТекстСтроки(ByVal ws As Worksheet, ByVal r As Long) As String
    Dim lastCol As Long, c As Long, s As String, v As String
    lastCol = ws.Cells(r, ws.Columns.Count).End(xlToLeft).Column
    For c = 1 To lastCol
        v = Trim$(CStr(ws.Cells(r, c).Text))
        If v <> "" Then s = s & " " & v
    Next c
    ТекстСтроки = Trim$(s)
End Function

Private Function ИзвлечьИмяБлокаДЭС(ByVal ws As Worksheet, ByVal r As Long) As String
    Dim s As String
    s = Trim$(ТекстСтроки(ws, r))
    If s = "" Then s = "Не определено"
    ИзвлечьИмяБлокаДЭС = s
End Function

Private Function ИзвлечьИмяБлокаКотельной(ByVal ws As Worksheet, ByVal r As Long) As String
    Dim s As String
    s = Trim$(ТекстСтроки(ws, r))
    If s = "" Then s = "Не определено"
    ИзвлечьИмяБлокаКотельной = s
End Function

Private Sub ОбновитьДЭСНП(ByVal dt As Date, ByVal np As String, ByVal loadVal As Double, ByVal outputVal As Double, ByVal fuelVal As Double, ByVal oilVal As Double, Optional ByVal stWork As Long = 0, Optional ByVal stReserve As Long = 0, Optional ByVal stRepair As Long = 0)
    Dim key As String, arr As Variant

    If np = "" Then np = "Не определено"
    key = Format$(dt, "yyyy-mm-dd") & "|" & np

    If gDESLocality.Exists(key) Then
        arr = gDESLocality(key)
    Else
        ReDim arr(1 To 10)
        arr(1) = 1E+30
        arr(2) = 0#
        arr(3) = 0#
        arr(4) = 0#
        arr(5) = 0#
        arr(6) = 0#
        arr(7) = 0
        arr(8) = 0
        arr(9) = 0
        arr(10) = 0
    End If

    If loadVal > 0 Then
        If loadVal < arr(1) Then arr(1) = loadVal
        If loadVal > arr(2) Then arr(2) = loadVal
        arr(3) = arr(3) + loadVal
        arr(7) = arr(7) + 1
    End If

    arr(4) = arr(4) + outputVal
    arr(5) = arr(5) + fuelVal
    arr(6) = arr(6) + oilVal
    arr(8) = arr(8) + stWork
    arr(9) = arr(9) + stReserve
    arr(10) = arr(10) + stRepair

    If arr(1) = 1E+30 Then arr(1) = 0
    gDESLocality(key) = arr
End Sub

Private Sub ОбновитьКотельныеНП(ByVal dt As Date, ByVal np As String, ByVal fuelVal As Double)
    Dim key As String, arr As Variant

    If np = "" Then np = "Не определено"
    key = Format$(dt, "yyyy-mm-dd") & "|" & np

    If gBoilerLocality.Exists(key) Then
        arr = gBoilerLocality(key)
    Else
        ReDim arr(1 To 4)
        arr(1) = 1E+30
        arr(2) = 0#
        arr(3) = 0#
        arr(4) = 0
    End If

    If fuelVal > 0 Then
        If fuelVal < arr(1) Then arr(1) = fuelVal
        If fuelVal > arr(2) Then arr(2) = fuelVal
        arr(3) = arr(3) + fuelVal
        arr(4) = arr(4) + 1
    End If

    If arr(1) = 1E+30 Then arr(1) = 0
    gBoilerLocality(key) = arr
End Sub

Private Sub ОчиститьСерии(ByVal ch As Chart)
    On Error Resume Next
    Do While ch.SeriesCollection.Count > 0
        ch.SeriesCollection(1).Delete
    Loop
    On Error GoTo 0
End Sub

Private Sub УдалитьВсеДиаграммы(ByVal ws As Worksheet)
    Dim i As Long
    For i = ws.ChartObjects.Count To 1 Step -1
        ws.ChartObjects(i).Delete
    Next i
End Sub

Private Sub ОтсортироватьДаты(ByRef arr As Variant)
    Dim i As Long, j As Long
    Dim tmp As Variant

    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If CDate(arr(j)) < CDate(arr(i)) Then
                tmp = arr(i)
                arr(i) = arr(j)
                arr(j) = tmp
            End If
        Next j
    Next i
End Sub

Private Sub ОтсортироватьСтроки(ByRef arr As Variant)
    Dim i As Long, j As Long
    Dim tmp As Variant

    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If CStr(arr(j)) < CStr(arr(i)) Then
                tmp = arr(i)
                arr(i) = arr(j)
                arr(j) = tmp
            End If
        Next j
    Next i
End Sub