---

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( _
        "Дата", "Файлов", "Ремонтов", "Нагрузка ДЭС, кВт", "Выработка ДЭС, кВт", _
        "Топливо ДЭС, л", "Топливо котельных, м3", "Общее топливо", _
        "ДГУ в работе", "ДГУ в резерве", "ДГУ в ремонте", "Кол-во причин", "Расход масла ДЭС")

    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 blockName 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
    blockName = ""

    For r = 1 To lastRow
        If ЭтоЗаголовокБлокаДЭС(ws, r) Then
            blockName = ИзвлечьИмяБлокаДЭС(ws, r)
            ИнициализироватьДЭСБлок dt, blockName
        ElseIf ЭтоСтрокаДЭС(ws, r) Then
            If blockName = "" Then blockName = "Не определено"

            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, blockName, ЧислоИзЯчейки(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, blockName 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
    blockName = ""

    For r = 1 To lastRow
        If ЭтоЗаголовокБлокаДЭС(ws, r) Then
            blockName = ИзвлечьИмяБлокаДЭС(ws, r)
            ИнициализироватьДЭСБлок dt, blockName
        ElseIf ЭтоСтрокаДЭС(ws, r) Then
            If blockName = "" Then blockName = "Не определено"
            v = ws.Cells(r, DES_COL_OUTPUT).Value
            totalOutput = totalOutput + ЧислоИзЯчейки(v)
            ОбновитьДЭСБлок dt, blockName, 0, ЧислоИзЯчейки(v), 0, 0, 0, 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, blockName 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
    blockName = ""

    For r = 1 To lastRow
        If ЭтоЗаголовокБлокаДЭС(ws, r) Then
            blockName = ИзвлечьИмяБлокаДЭС(ws, r)
            ИнициализироватьДЭСБлок dt, blockName
        ElseIf ЭтоСтрокаДЭС(ws, r) Then
            If blockName = "" Then blockName = "Не определено"
            v = ws.Cells(r, DES_COL_FUEL).Value
            totalFuel = totalFuel + ЧислоИзЯчейки(v)
            ОбновитьДЭСБлок dt, blockName, 0, 0, ЧислоИзЯчейки(v), 0, 0, 0, 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, blockName 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
    blockName = ""

    For r = 1 To lastRow
        If ЭтоЗаголовокБлокаДЭС(ws, r) Then
            blockName = ИзвлечьИмяБлокаДЭС(ws, r)
            ИнициализироватьДЭСБлок dt, blockName
        ElseIf ЭтоСтрокаДЭС(ws, r) Then
            If blockName = "" Then blockName = "Не определено"
            v = ws.Cells(r, DES_COL_OIL).Value
            totalOil = totalOil + ЧислоИзЯчейки(v)
            ОбновитьДЭСБлок dt, blockName, 0, 0, 0, ЧислоИзЯчейки(v), 0, 0, 0
        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, blockName 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
    blockName = ""

    For r = 1 To lastRow
        If ЭтоЗаголовокБлокаКотельной(ws, r) Then
            blockName = ИзвлечьИмяБлокаКотельной(ws, r)
            ИнициализироватьКотельныйБлок dt, blockName
        ElseIf ЭтоСтрокаКотельной(ws, r) Then
            If blockName = "" Then blockName = "Не определено"
            v = ws.Cells(r, fuelCol).Value
            totalFuel = totalFuel + ЧислоИзЯчейки(v)
            ОбновитьКотельныйБлок dt, blockName, ЧислоИзЯчейки(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(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, blockName 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
        blockName = Trim$(CStr(wsSrc.Cells(r, 2).Value))
        If blockName <> "" 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(blockName) Then
                arr = dict(blockName)
                If arr(1) = 0 Then
                    arr(1) = mn
                ElseIf mn > 0 And mn < arr(1) Then
                    arr(1) = mn
                End If
                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(blockName) = 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, blockName 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
        blockName = Trim$(CStr(wsSrc.Cells(r, 2).Value))
        If blockName <> "" 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(blockName) Then
                arr = dict(blockName)
                If arr(1) = 0 Then
                    arr(1) = mn
                ElseIf mn > 0 And mn < arr(1) Then
                    arr(1) = mn
                End If
                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(blockName) = 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