Загрузка данных
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 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 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 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 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, 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, 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