Для внутреннего самоконтроля используется разбиение дел на подзадачи, и ежедневный отчет о проделанной работе. Данный список ведется в 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 переменная.