Я уже прикинул вариант, работает, считает без ошибок. Смысл в том, что человек заполняет таблицу указывая "еднерками" выполненные пункты в каждой категории, а руководитель пересчитывает это все в рубли для предварительной оценки работы. Есть варианты по оптимизации? Как можно реализовать подгрузку соответствий из отдельного листа, на подобии таблицы соответствий, чтобы ценность позиций 9,10,11,12,13 ОМ, ОК, ОБ, ОКБД не в коде прописывать, а в таблице на листе, откуда макрос их заберет. Что добавить в макрос, для создания функции "=промежуточные.итоги(109;ХХ:УУ)" в 3 сроке 14 столбце и шапкой "Итого", охват функции должен быть все строки и столбцы с 9 по 13. Макрос состоит из 2 частей - 1 часть стырил на форуме. Он берет данные в исходной книге, к которой подключены таблицы исполнителей на отдельных листах, и объединяет в одну таблицу, благо кол-во столбцов фиксированное (в идеале), все это дело пихает в новую книгу. Вторую часть макроса придумал сегодня сам, она меняет в общей таблице в новой книге все 1 на кастомные значения.
| Код |
|---|
Sub sborka()
Dim y As Integer
Dim lLastRow As Integer
s_ = Sheets.Count
Workbooks.Add
ThisWorkbook.Sheets(1).Range("1:1").Copy ActiveWorkbook.Sheets(1).Range("a1")
For i = 1 To s_
r_ = ActiveWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp).Row + 1
ThisWorkbook.Sheets(i).Range("a1").CurrentRegion.Offset(1).Copy ActiveWorkbook.Sheets(1).Range("a" & r_)
Next
lLastRow = Cells.SpecialCells(xlLastCell).Row
For y = 2 To lLastRow
If Cells(y, 7) = "ОМ" Then
If Cells(y, 9) = 1 Then Cells(y, 9) = 50
If Cells(y, 10) = 1 Then Cells(y, 10) = 50
If Cells(y, 11) = 1 Then Cells(y, 11) = 50
If Cells(y, 12) = 1 Then Cells(y, 12) = 50
If Cells(y, 13) = 1 Then Cells(y, 13) = 50
End If
Next y
For y = 2 To lLastRow
If Cells(y, 7) = "ОК" Then
If Cells(y, 9) = 1 Then Cells(y, 9) = 110
If Cells(y, 10) = 1 Then Cells(y, 10) = 210
If Cells(y, 11) = 1 Then Cells(y, 11) = 80
If Cells(y, 12) = 1 Then Cells(y, 12) = 100
If Cells(y, 13) = 1 Then Cells(y, 13) = 100
End If
Next y
For y = 2 To lLastRow
If Cells(y, 7) = "ОБ" Then
If Cells(y, 9) = 1 Then Cells(y, 9) = 210
If Cells(y, 10) = 1 Then Cells(y, 10) = 310
If Cells(y, 11) = 1 Then Cells(y, 11) = 160
If Cells(y, 12) = 1 Then Cells(y, 12) = 160
If Cells(y, 13) = 1 Then Cells(y, 13) = 160
End If
Next y
For y = 2 To lLastRow
If Cells(y, 7) = "ОКБД" Then
If Cells(y, 9) = 1 Then Cells(y, 9) = 170
If Cells(y, 10) = 1 Then Cells(y, 10) = 210
If Cells(y, 11) = 1 Then Cells(y, 11) = 90
If Cells(y, 12) = 1 Then Cells(y, 12) = 120
If Cells(y, 13) = 1 Then Cells(y, 13) = 110
End If
Next y
End Sub |
