Для внутреннего самоконтроля используется разбиение дел на подзадачи, и ежедневный отчет о проделанной работе. Данный список ведется в excel, отчет по каждому пункту допускает текстовое содержимое и выделение цветом в соответствии с принятым соглашением. На основании недельных результатов формируется недельный отчет с целью внесения корректировок в процесс. Задача облегчить оценку недельного результата.
Вступление
На разработанном коде можно посмотреть некоторые особенности VBA и в случае необходимости освежить в памяти, особенно когда редко приходится им пользоваться. В коде есть функция для тестирования, аналог unit тестов. Хочу обратить внимание разработчиков макросов на то что код экспортированных модулей можно сохранять в система контроля версий (например, Subversion, Git), чтобы можно было видеть произведенные изменения.
Требования
Каждой подзадаче соответствует правило ее ежедневного выполнения:
| Код правила | Описание правила |
| А | Необходимо еще дневное выполнение по данному пункту |
| Б | Достаточно одного выполнения |
| К | Критическое состояние, достаточно одного провала |
| О | Опциональное значение, не влияющие на итоговую оценку |
Критерии ежедневного отчета (задаются фоновым цветом):
| Цвет | Описание |
 | Полное выполнение |
 | Частичное выполнение |
 | Провалено |
 | Временное игнорирование (применимо только к правилу, требующему ежедневного выполнения) |
Критерии недельного отчета:
| Правило | Описание |
| А | Из анализа должны исключаться проигнорированные дни. Возможные результаты: полное/частичное выполнение, провал, неопределенное состояние, когда не сформирована отчет за день |
| Б | Достаточно наличие хотя бы одного полного или частичного выполнения |
| К | Одного провала или частичного выполнения достаточно чтобы считать подзадачу проваленной |
| О | Если допущен провал в том, что не надо было делать, то провалено, в остальных случая успешное завершение |
Реализация
'---------------------------------
' типы данных
'---------------------------------
Type TSequenceInfo
iSuccessCount As Integer 'полностью выполнено
iPartiallyCompleted As Integer 'частично выполненно
iFailedCount As Integer 'полновтью выполненно
iIgnoreCount As Integer 'проигнорированные ячейки
iSkipedCount As Integer 'количество ячеек в которых пропущен цвет
iCellsCount As Integer 'общее количество ячеек
End Type
Type TTestCase
value As String
rule As String
result As String
End Type
Type TTests
count As Integer
tests(1 To 30) As TTestCase
End Type
'---------------------------------
' доступные состояния
'---------------------------------
Enum EState
E_STATE_SUCCESS = xlThemeColorAccent6 'Успешное завершение операции
E_STATE_PARTITION_EXECUTION = xlThemeColorAccent1 'частичное выполнение
E_STATE_FAILED = xlThemeColorAccent2 'Проваленное выполнение
E_STATE_IGNORE = xlThemeColorAccent4 'временное игнорирование
E_STATE_UNKNOWN = xlNone
End Enum
Const E_STATE_NAME_SUCCESS = "S" 'Успешное завершение операции
Const E_STATE_NAME_PARTITION_EXECUTION = "P" 'частичное выполнение
Const E_STATE_NAME_FAILED = "F" 'Проваленное выполнение
Const E_STATE_NAME_IGNORE = "I" 'Игнорировать содержимое
Const E_STARE_NAME_UNKNOWN = "U" 'неопределенное значение
'---------------------------------
' доступные правила
'---------------------------------
Const E_RULE_NEED_EVERY_DAY_EXECUTION = "А" 'необходимо ежедневное выполнение
Const E_RULE_AT_LEAST_ONCE = "Б" 'достаточно одного выполнения
Const E_RULE_CRITICAL = "К" 'достаточно одного провала, либо неполного выполнения
Const E_RULE_OPTIONAL = "О" 'опциональное значение, не влияющие на итоговый результат
'Проверяет требование чтобы были заполнены все дни
'Если какой-то из дней пропущен, то программа не может дать оценку, результат неизвестве
Function getStateByNeedEveryDayExecutionRule(sequenceInfo As TSequenceInfo) As String
Dim result As String
Dim iSignificantValue As Integer
'количество значащих ячеек
iSignificantValue = sequenceInfo.iCellsCount - sequenceInfo.iIgnoreCount
If sequenceInfo.iSuccessCount + sequenceInfo.iPartiallyCompleted <> iSignificantValue Then
If sequenceInfo.iFailedCount <> 0 Then
result = E_STATE_NAME_FAILED
Else
result = E_STARE_NAME_UNKNOWN
End If
ElseIf sequenceInfo.iSuccessCount = iSignificantValue Then
result = E_STATE_NAME_SUCCESS
Else
result = E_STATE_NAME_PARTITION_EXECUTION
End If
getStateByNeedEveryDayExecutionRule = result
End Function
'Проверка условия, чтобы было выполнено хотя бы в один день
Function getStateByAtLeastOnceExecutionRule(sequenceInfo As TSequenceInfo) As String
Dim result As String
If sequenceInfo.iSuccessCount <> 0 Or sequenceInfo.iPartiallyCompleted <> 0 Then
result = E_STATE_NAME_SUCCESS
Else
result = E_STATE_NAME_FAILED
End If
getStateByAtLeastOnceExecutionRule = result
End Function
'Проверка того, что не было сорвано выполнение
Function getStateByCriticalExecutionRule(sequenceInfo As TSequenceInfo) As String
Dim result As String
If sequenceInfo.iFailedCount <> 0 Or sequenceInfo.iPartiallyCompleted <> 0 Then
result = E_STATE_NAME_FAILED
Else
result = E_STATE_NAME_SUCCESS
End If
getStateByCriticalExecutionRule = result
End Function
'Возможно что-то было выполненно, или нет, главное, чтобы провала не было
Function getStateByOptionalExecutionRule(sequenceInfo As TSequenceInfo) As String
Dim result As String
If sequenceInfo.iFailedCount <> 0 Then
result = E_STATE_NAME_FAILED
Else
result = E_STATE_NAME_SUCCESS
End If
getStateByOptionalExecutionRule = result
End Function
'Определение характиристик строки
Function getStringSequenceInfo(sStrWithCodes As String) As TSequenceInfo
Dim result As TSequenceInfo
result.iCellsCount = Len(sStrWithCodes)
For iCharPos = 1 To result.iCellsCount
sCurrentChar = Mid(sStrWithCodes, iCharPos, 1)
Select Case sCurrentChar
Case E_STATE_NAME_SUCCESS:
result.iSuccessCount = result.iSuccessCount + 1
Case E_STATE_NAME_PARTITION_EXECUTION:
result.iPartiallyCompleted = result.iPartiallyCompleted + 1
Case E_STATE_NAME_FAILED:
result.iFailedCount = result.iFailedCount + 1
Case E_STATE_NAME_IGNORE:
result.iIgnoreCount = result.iIgnoreCount + 1
Case E_STARE_NAME_UNKNOWN:
result.iSkipedCount = result.iSkipedCount + 1
End Select
Next iCharPos
getStringSequenceInfo = result
End Function
'Преолбразование кода цвета к строковому коду
Function interiorToCode(pCellInterrior As Interior) As String
Dim result As String
If pCellInterrior.Pattern <> E_STATE_UNKNOWN Then
Select Case pCellInterrior.ThemeColor
Case E_STATE_SUCCESS:
result = E_STATE_NAME_SUCCESS
Case E_STATE_PARTITION_EXECUTION:
result = E_STATE_NAME_PARTITION_EXECUTION
Case E_STATE_FAILED:
result = E_STATE_NAME_FAILED
Case E_STATE_IGNORE:
result = E_STATE_NAME_IGNORE
End Select
Else
result = E_STARE_NAME_UNKNOWN
End If
interiorToCode = result
End Function
'Определение характеристик диапазона
Function getRangeSequenceInfo(pCells As Range, bUseInterrior As Boolean) As TSequenceInfo
Dim pCell As Range
Dim sStrWithCodes As String
'Application.Volatile
sStrWithCodes = ""
If bUseInterrior Then
For Each pCell In pCells
sStrWithCodes = sStrWithCodes & interiorToCode(pCell.Interior)
Next pCell
Else
For Each pCell In pCells
sStrWithCodes = sStrWithCodes & pCell.value
Next pCell
End If
getRangeSequenceInfo = getStringSequenceInfo(sStrWithCodes)
End Function
Function getGrade(sequenceInfo As TSequenceInfo, sRule As String) As String
Dim result As String
Select Case sRule
Case E_RULE_NEED_EVERY_DAY_EXECUTION:
result = getStateByNeedEveryDayExecutionRule(sequenceInfo)
Case E_RULE_AT_LEAST_ONCE:
result = getStateByAtLeastOnceExecutionRule(sequenceInfo)
Case E_RULE_CRITICAL:
result = getStateByCriticalExecutionRule(sequenceInfo)
Case E_RULE_OPTIONAL:
result = getStateByOptionalExecutionRule(sequenceInfo)
Case Else
result = E_STARE_NAME_UNKNOWN
End Select
getGrade = result
End Function
Function getStringGrade(sStr As String, sRule As String) As String
Dim sequenceInfo As TSequenceInfo
sequenceInfo = getStringSequenceInfo(sStr)
getStringGrade = getGrade(sequenceInfo, sRule)
End Function
'Основная функция
'pCells - анализируемый диапазон ячеек
'sRule - правило анализа диапазона (возможные значения: E_RULE_)
'bUseInterrior - использовать в качестве критерия для оценки заливку ячеек
' возможен анализ содержимого (должны быть значения: E_STATE_NAME_*)
'Возвращаемое значение:
'E_STATE_NAME_*
Function getRangeGrade(pCells As Range, sRule As String, Optional bUseInterrior As Boolean = True) As String
Dim sequenceInfo As TSequenceInfo
sequenceInfo = getRangeSequenceInfo(pCells, bUseInterrior)
getRangeGrade = getGrade(sequenceInfo, sRule)
End Function
Function createTest(sValue As String, sRule As String, sResult As String) As TTests
Static pTests As TTests
pTests.count = pTests.count + 1
With pTests.tests(pTests.count)
.value = sValue
.rule = sRule
.result = sResult
End With
createTest = pTests
End Function
'код ф-й немного измененный ответ из: https://stackoverflow.com/questions/17233701/obtaining-the-equivalent-to-printf-or-string-format-in-excel
Public Function sprintf(ByVal sStr As String, ParamArray tokens()) As String
Dim i As Long
For i = 0 To UBound(tokens)
sStr = Replace$(sStr, "{" & i + 1 & "}", tokens(i))
Next
sprintf = sStr
End Function
Sub functionTest()
'аналог unut тестов
Dim pTests As TTests
Dim sGrade As String
createTest "D", "", E_STARE_NAME_UNKNOWN
' 1-й критерий оценки
createTest E_STATE_NAME_SUCCESS & E_STATE_NAME_SUCCESS & E_STATE_NAME_SUCCESS, _
E_RULE_NEED_EVERY_DAY_EXECUTION, _
E_STATE_NAME_SUCCESS
createTest E_STATE_NAME_SUCCESS & E_STATE_NAME_PARTITION_EXECUTION & E_STATE_NAME_SUCCESS, _
E_RULE_NEED_EVERY_DAY_EXECUTION, _
E_STATE_NAME_PARTITION_EXECUTION
createTest E_STATE_NAME_SUCCESS & E_STATE_NAME_FAILED & E_STATE_NAME_SUCCESS, _
E_RULE_NEED_EVERY_DAY_EXECUTION, _
E_STATE_NAME_FAILED
createTest E_STATE_NAME_SUCCESS & E_STARE_NAME_UNKNOWN & E_STATE_NAME_SUCCESS, _
E_RULE_NEED_EVERY_DAY_EXECUTION, _
E_STARE_NAME_UNKNOWN
createTest E_STATE_NAME_FAILED & E_STARE_NAME_UNKNOWN & E_STARE_NAME_UNKNOWN, _
E_RULE_NEED_EVERY_DAY_EXECUTION, _
E_STATE_NAME_FAILED
' 2-й критерий оценки
createTest E_STATE_NAME_SUCCESS & E_STATE_NAME_SUCCESS & E_STATE_NAME_SUCCESS, _
E_RULE_AT_LEAST_ONCE, _
E_STATE_NAME_SUCCESS
createTest E_STATE_NAME_PARTITION_EXECUTION & E_STARE_NAME_UNKNOWN, _
E_RULE_AT_LEAST_ONCE, _
E_STATE_NAME_SUCCESS
createTest E_STARE_NAME_UNKNOWN & E_STARE_NAME_UNKNOWN, _
E_RULE_AT_LEAST_ONCE, _
E_STATE_NAME_FAILED
' 3-й критерий оценки
createTest E_STARE_NAME_UNKNOWN & E_STARE_NAME_UNKNOWN, _
E_RULE_CRITICAL, _
E_STATE_NAME_SUCCESS
createTest E_STATE_NAME_SUCCESS & E_STARE_NAME_UNKNOWN, _
E_RULE_CRITICAL, _
E_STATE_NAME_SUCCESS
pTests = createTest(E_STATE_NAME_PARTITION_EXECUTION & E_STARE_NAME_UNKNOWN, _
E_RULE_CRITICAL, _
E_STATE_NAME_FAILED)
'проверка тестов
For iTestIndex = 1 To pTests.count
'попытка вычислить
With pTests.tests(iTestIndex)
sGrade = getStringGrade(.value, .rule)
If sGrade <> .result Then
Debug.Print sprintf("Failed test {1}: Test:[{2}] Rule:[{3}] Result:[{4}]", iTestIndex, .value, .rule, .result)
Debug.Print "Exit programm"
End
End If
End With
Next iTestIndex
End Sub
Некоторые пояснения
Основная функция, выполняющая задачу – getRangeGrade. В качестве результата она возвращает строковое представление оценки. Введя функцию условного форматирования можно выделять ячейку нужным цветом. Данную функцию можно также использоваться для анализа результата групп подзадача, передавая на вход ячейки, содержащие результат анализа ежедневных отчетов подзадач и задавая параметр bUseInterrior.
Тестирования корректности кода производится функцией functionTest, при этом для сохранения набора тестов применяется static переменная.