Sub Delnot4G() ' удаление строк, в которых нет 4G - рабочая
Application.ScreenUpdating = False
Dim lLastCol As Long, i&
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row ' определяем номер последней строки
With Worksheets("1") ' лист должен называться "1"
For i = lLastRow to 2 Step -1 ' обработка в обратном порядке, т.е. с конца таблицы
If Not (Cells(i, 13) like "*4G*") Then Rows(i).Delete ' если в столбце M (13) значение не равно 4G, то удалить строку
Next i
End With
End Sub
Sub TTRR_2_DelToERBS()
' удаление в столбце "K" всего текста до позиции "ERBS"
Application.ScreenUpdating = False
Dim s As String, lLastCol As Long, MyPos, i&, b
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = lLastRow To 2 Step -1
MyPos = InStr(1, Cells(i, 11), "ERBS", vbTextCompare)
b = MyPos - 1
s = Cells(i, 11).Value
s = Right(s, (Len(s) - b))
Cells(i, 11).Value = s
Next i
' удаление в столбце "M" всего текста до позиции "4G:"
For i = lLastRow To 2 Step -1
MyPos = InStr(1, Cells(i, 13), "4G:", vbTextCompare)
b = MyPos - 1
s = Cells(i, 13).Value
s = Right(s, (Len(s) - b))
Cells(i, 13).Value = s
' определение региона 51 - Актау, 61 - Атырау
If Cells(i, 11) like "ERBS_5*" Then Cells(i,3).Value = "Aktau(M)"
if Cells(i, 11) like "ERBS_61*" Then Cells(i,3).Value = "Atyrau"
Next i
End Sub
Sub TTRR_3_countMIN()
Application.ScreenUpdating = False
' подсчет downtime как разница между finish_date и start_date (в минутах)
Columns(16).EntireColumn.Insert 'вставка столбца перед столбцом Р
Dim s As String, lLastCol As Long, MyPos, i&, b
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("P2").Select
For i = lLastRow To 2 Step -1
Cells(i, 16).Value = "=(RC[-1]-RC[-2])*24*60"
Next i
Columns("P:P").Select
Selection.NumberFormat = "0"
Range("P1").Select
ActiveCell.FormulaR1C1 = "Downtime" ' присвоение имени столбцу
End Sub
Sub TTRR_4_Prioritet()
' присвоение приоритетов ТТ
Application.ScreenUpdating = False
Columns(14).EntireColumn.Insert 'вставка столбца перед столбцом N
Dim lLastRow As Long, i&, t&, arr
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = lLastRow To 2 Step -1
If InStr(1, Cells(i, 13), ":", vbTextCompare) Then
arr = Split(Cells(i, 13), ":", 2)
t = Split(arr(1), ",")(0)
Select Case True
Case t = 1: Cells(i, 14).Value = 4
Case t > 1 And t < 5: Cells(i, 14).Value = 3
Case t > 4 And t < 20: Cells(i, 14).Value = 2
Case t > 19: Cells(i, 14).Value = 1
End Select
End If
Next i
Range("N1").FormulaR1C1 = "Priority" ' переименование столбца "N"
End Sub
Sub TTRR_5_opredPrevisheniya()
' определение ТТ с превышением (признак 1) нормативного времени решения
Application.ScreenUpdating = False
Columns(18).EntireColumn.Insert 'вставка столбца перед столбцом R
Dim s As String, lLastCol As Long, MyPos, i&, b
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = lLastRow To 2 Step -1
If Cells(i, 14).Value = 4 Then If (1441 - Cells(i, 17).Value) > 0 Then Cells(i, 18).Value = 0 Else Cells(i, 18).Value = 1
If Cells(i, 14).Value = 3 Then If (481 - Cells(i, 17).Value) > 0 Then Cells(i, 18).Value = 0 Else Cells(i, 18).Value = 1
If Cells(i, 14).Value = 2 Then If (361 - Cells(i, 17).Value) > 0 Then Cells(i, 18).Value = 0 Else Cells(i, 18).Value = 1
If Cells(i, 14).Value = 1 Then If (241 - Cells(i, 17).Value) > 0 Then Cells(i, 18).Value = 0 Else Cells(i, 18).Value = 1
Next i
Range("R1").Select
ActiveCell.FormulaR1C1 = "Out_of_Norm" ' переименование столбца "R"
End Sub
Sub TTRR_Ultimate()
Call TTRR_1_DelNot4G
Call TTRR_2_DelToERBS
Call TTRR_3_countMIN
Call TTRR_4_Prioritet
Call TTRR_5_opredPrevisheniya
End Sub
|
