Подсчет выполненных и невыполненных подпунктов на странице "Проекты" с указанием процентов выполнения

Выполняя задачу без четко обозначенного конца, не видя прогресса ее исполнения, рано или поздно она надоедает и превращается в обременение, которое ложится тяжким грузом на плечи и становится непосильной. Так как нет чёткого представления о прогрессе её выполнения.

Невозможно качественно выполнить долгоиграющую задачу без отслеживания процесса её исполнения. При таком подходе рано или поздно наступает момент, когда задача превращается в рутину, попросту надоедает, и в конечном итоге вы ее бросаете, хотя до успеха, как правило, остается пару шагов, которые вы, к сожалению, не видите. Так и получается, что, начав что-то делать, мы не доводим это до конца.

Дабы не наступать на аналогичные грабли при выполнении задач в несколько действий и довести дело до 100%-го исполнения, необходимо доработать Планеро в части автоматического подсчета выполненных и невыполненных подпунктов на странице «Проекты» с указанием процента выполнения задачи в целом.

' обновление "Выполнено __ из __ - %"
i = 0' для прохода по задачам, начинаем с B3 + i
' проходим вниз до тех пор пока есть Наименования задачи в столбце B
Do While pr.Range("B3").Offset(i, 0) > 0 Or pr.Range("C3").Offset(i, 0) > 0
' если найдено наименование задачи
If pr.Range("B3").Offset(i, 0) > 0 Then
j = i + 1' для прохода по подпунктам задачи
k = 0' подсчет выполненных пунктов
h = 1' номер подпункта
h2 = 1' общее количество подпунктов
' проходим по подпунктам задачи
Do While (Len(pr.Range("D3").Offset(j, 0)) > 0 And Len(pr.Range("B3").Offset(j, 0)) = 0) Or (Len(pr.Range("C3").Offset(j, 0)) > 0 And Len(pr.Range("B3").Offset(j, 0)) = 0)
' если подпункт зачеркнут - считаем его выполненным
If pr.Range("D3").Offset(j, 0).Font.Strikethrough = True Then k = k + 1
' если нет подгруппы подпункта - нумеруем, если есть - обнуляем нумерацию
If Len(pr.Range("D3").Offset(j, 0)) > 0 Then
pr.Range("C3").Offset(j, 0) = h
Else
h = 0
End If
h = h + 1' увеличиваем номер подпункта на +1
h2 = h2 + 1' увеличиваем общее количество подпунктов на +1
j = j + 1' переходим к следующему подпункту, увеличив на +1
Loop
' уменьшаем количество подпунктов (номер и общее количество), т.к. последнего не существует
h = h - 1
h2 = h2 - 1

' если в ячейке "Комментарии" задачи записей нет, добавляем в ячейку "Комментарии" информацию о выполнении
If Len(pr.Range("H3").Offset(i, 0)) = 0 Then
pr.Range("H3").Offset(i, 0) = "[Выполнено " & k & " из " & h & " - " & Round(k * 100 / h2) & "%]"
' в противном случае, добавляем в начало ячейки "Комментарии" информацию о выполнении
Else
' сохраняем данные из ячейки "Комментарии" в переменную
str2 = pr.Range("H3").Offset(i, 0)
' если в ячейке "Комментарии" отсутствует запись о количестве выполнных подпунктов - добавляем ее в начале строки
If InStr(1, str2, "[") = 0 Then
pr.Range("H3").Offset(i, 0) = "[Выполнено " & k & " из " & h2 & " - " & Round(k * 100 / h2) & "%]" & Chr(10) & str2
' в противном случае, корректируем её
Else
' находим в ячейке "Комментарии" запись о выполненных подзадачах и заменяем ее на обновленные данные
' находим начало и окончание записи "Выполнено N из M - 000%"
newstr = Mid(str2, InStr(1, str2, "[") + 1, InStr(1, str2, "]") - InStr(1, str2, "[") - 1)
' заменяем подстроку "Выполнено N из M - 000%" на обновленные данные
pr.Range("H3").Offset(i, 0) = Replace(str2, newstr, "Выполнено " & k & " из " & h2 & " - " & Round(k * 100 / h2) & "%")
End If
End If
End If
' переходим к следующей задаче на листе "Проекты"
i = i + 1
Loop

Теперь, при нажатии на кнопку «Обновить», происходит автоматический подсчёт выполненных и невыполненных подпунктов с общим процентом выполнения задачи в целом, и размещением соответствующей информации в столбце «Комментарии». Наглядный итог работы можно увидеть ниже:

Прогресс выполнения
Отображение прогресса выполнения задачи на листе «Проекты»

Следующим шагом реализуем автоматическое формирование списка актуальных задач на главной странице и возможностью перемещения к соответствующему пункту.

Актуальная версия Планеро доступна по ссылке.

Поделись с друзьями:
Комментарии 2

© планеро.ru