mamalot (Автор тем)

Расчет количества ТМЦ для изготовления металлоконструкций

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

12.11.2020 16:17:14

Добрый день.
Может, делал кто для себя в экселе расчет количества ТМЦ для изготовления арматуры на ЛЭП 0,4-10 кВ (например: траверсы ТМ, ТН; хомуты, оголовки и т.д.) - поделитесь пожалуйста.
Проблема в чём: начал считать согласно чертежа по деталировке - получаются одни цифры; начал считать по размерам по чертежу с помощью Металлического калькулятора - другие цифры. Запутался.
P.S. Если обратился не туда-прошу прощения.

Перейти

Запрет на переключение на другие приложения до окончания работы макроса в рабочей книге.

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

29.07.2019 07:56:24

Добрый день.
Есть книга с макросами (для облегчения рутины). Отдал книгу коллегам. Коллеги жалуются что не работает (выходит окно аварийного завершения работы макроса по различным причинам).
Как оказалось - во время работы макроса пользователь переключается (мышкой или клавишами) (колесико крутится а им скучно) на другую книгу эксель/программу и появляется ошибка (что вполне логично: в другой книге другие данные и структура).
Вопрос: как запретить переключение между рабочей книгой и другими книгами эксель и другими программами, пока не закончит работу макрос в рабочей книге (посмотрел на просторах не нашёл).
Спасибо.

Перейти

Использование имени книги из ячейки листа активной книги для активации макроса другой открытой не активной книги

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

12.04.2019 09:02:24

Добрый день.
Как есть.
Есть две книги. Открываем книгу "цвет22", открываем книгу "цвет22_123". При открытии последней книги в появившемся сообщении выбираем "ДА". При этом активируется макрос из первой книги.
Для активации макроса из первой книги используется:

Код
Call Application.Run("'цвет22.xlsb'!Module1.макрос1")

Всё работает прекрасно.
Но: периодически названия обоих книг меняется. После переименования приходится руками перепрописывать названия книг в макросах.
Как хочется.
Хочется чтобы названия книг брались из ячеек листов книг в которых прописаны их названия (названия меняются автоматически при изменении имён книг-формулы).
Пытался использовать конструкцию:

Код
a = Sheets("Лист1").Cells(1, 3).Value b = a & "'!Module1.макрос1""" Call Application.Run("'b")

(эта конструкция сейчас в макросе закомментирована) но выдаёт ошибку:

Код
Run-time error '1004', Application-defiened or object-defined error

Ошибка или в способе каким я пытаюсь реализовать свою задумку или в синтаксисе. Честно искал, но понять мне не дано.
Прошу помощи.

Изменено: mamalot - 12.04.2019 09:04:34

Перейти

Контроль ввода значений в диапазоне

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

17.01.2019 11:53:04

Добрый день.
Есть макрос в модуле лиса "Лист1" (по-моему здесь на форуме нарыл) который заливает цветом все изменённые ячейки-всё работает отлично.

Код

Private Sub Worksheet_Change(ByVal Target As Range)
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False 
    Dim vValue
    On Error Resume Next
       If Target <> vValue Then Target.Interior.Color = vbGreen
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
End Sub

Переделал макрос (в модуле лиса "Лист2") который заливает цветом ячейку в которую ввели ноль-тоже всё работает.

Код

Private Sub Worksheet_Change(ByVal Target As Range)
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False  
    Dim vValue
    On Error Resume Next
       If Target = 0 Then Target.Interior.Color = vbGreen
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
End Sub

А вот если переделать макрос чтобы менял введённый ноль на пусто (в модуле лиса "Лист3") -эксель вылетает, аварийно закрывается.

Код

Private Sub Worksheet_Change(ByVal Target As Range)
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False  
    Dim vValue
    On Error Resume Next
       If Target = 0 Then Target.Value = ""
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
End Sub

У меня задача: ячейка, в контролируемом диапазоне, должна оставаться пустой (очищаться) если в неё пытаются ввести ноль либо любое не числовое значение путём прямого ввода или при вставке скопированного диапазона (пока пытался решить для ноля).
Вообще я пытался решить этот вопрос с помощью проверки данных, но она слетает если вставлять скопированный диапазон. Запрещать вставку скопированного диапазона нельзя.
Гуглил не один день по данному вопросу, но-увы, чего-то мне не хватило.
Мой уровень-найти подходящее, попытаться понять как работает, переделать под себя.
Прошу подсказать в какую сторону рыть

Изменено: mamalot - 17.01.2019 13:48:30

Перейти

Неактивен фильтр в файле с ограниченным доступом

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

11.12.2018 09:39:03

Добрый день.
Файл Excel 2013 в формате .xlsb лежит на SharePoint.
Через: файл-защита книги-ограничить доступ-ограниченный доступ - раздаю права сотрудникам. У одних полный доступ, у других - только для чтения с правом копировать содержимое.
Проблема: у пользователей с правом для чтения неактивен автофильтр, что очень неудобно.
Про другие способы совместной работы в книге читал, но пока отрабатываю этот.
Как мне объяснили, к файлу, лежащему на SharePoint,по умолчанию все пользователи имеют полный доступ (у пользователей на этом этапе нет проблем). Проблема возникает после разграничения доступа встроенными средствами Excel.
Как можно исправить ситуацию с неактивным автофильтром при данном способе разграничения доступа к файлу?

Перейти

Сохранение резервной копии файла с сервера на конкретный компьютер

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

06.12.2018 09:29:33

Воспользовавшись советом из приёмов пытаюсь настроить сохранение резервной копии файла из корпоративной сети на свой, конкретный компьютер.
Когда файл редактирую я, копия сохраняется на моём компьютере по пути "C:\Р\Р_2019 конец\Р_2019_приложения №40\Резервные копии 2019" без проблем.
Когда редактирует коллега - появляется сообщение что указанной папки не существует (что вполне логично, у коллеги не такой папки).
Что нужно дописать в путь сохранения копии файла, что бы она сохранялась на моём компьютере, даже если с файлом работал мой коллега?
Гуглил, но или спрашиваю не правильно, или ещё что-то - не нашёл ответ на свой вопрос.

Перейти

Проверка данных вводимых в ячейку на VBA

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

21.08.2018 10:22:40

Добрый день.
Мучаюсь второй день (тупой я).
Необходимо чтобы после ввода данных в ячейку макрос проверил данные и если оно не проходят по критериям-выходим.
В ячейку вводятся числа (1,2,3,4,5,6,7,8,9,10,11,12) через запятую в различных комбинациях (может быть просто 4).
Необходимо получить все числа, разделённые запятыми и если хотябы одно число <1 или >12-выходим.
Не могу извлечь числа расположенные между запятыми.
На форуме находил подобные темы, но прикрутить не смог под свой случай.
Макрос в модуле листа:

Код

Sub Worksheet_Change(ByVal Target As Range)
    Dim tx As String
    Dim i As Long
    Dim t As String
    
    If Intersect(Target, Range("B:B")) Is Nothing Then
        Exit Sub
    End If
    If Target.Count > 1 Then Exit Sub
    tx = Target.Value
    If Len(tx) = 0 Then Exit Sub
    For i = 1 To Len(tx)
        t = Mid(tx, i, 1)
        If IsNumeric(t) Then
        MsgBox t
        If t > 12 Then
        MsgBox "Неверные данные"
        End If
        End If
    Next i
End Sub

Изменено: mamalot - 21.08.2018 10:23:04

Перейти

Суммирование значений на листе по множеству групп условий с переносом значений на итоговый лист, Аналог формулы суммеслимн на VBA

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

23.05.2018 15:04:56

Имеется книга (скорее она имеет меня) в формате xlsb весом более 11 мб. В книге на нескольких листах заносятся данные (не таблица). С этих листов собираются данные на итоговый лист с помощью формулы вида "СУММЕСЛИМН" по множеству условий. В результате один только итоговый лист имеет приличный вес (более 1,5 мб) и формулы, при изменении данных на листах, постоянно пересчитываются, что вызывает незначительные подвисания (пересчет одного листа насколько я знаю нельзя отключить, а если отключить пересчет всей книги - то юзеры, а иногда и я сам, пугаемся).
Дабы уменьшить вес файла (а он имеет склонность к набору веса) и избавиться от подтормаживаний решил попробовать реализовать заполнение таблицы на итоговом листе макросом (что-то типа аналога формулы СУММЕСЛИМН). Логика: переходим на нужный лист, суммируем данные по наборам условий, делам двенадцать циклов (месяцы года), выгружаем на итоговый лист. И так по всем листам с данными.
В итоге получилось сделать макросы для замены формул, но они отрабатывают более двух часов, что не есть хорошо.
Головой понимаю что нужно использовать массивы и т.д. (сводная таблица, например не вариант так как данные заносятся в форму не имеющую вида таблицы), но к сожалению я в них не силен.
Ниже приведен код одного из макросов (извините не нашел кнопку с плюсом что бы сворачивать/разворачивать) (знаний хватает только вот на такой вот мусор), он отрабатывает порядка шести минут. Файл-пример - сомневаюсь что он пролезет по весу.
Может кто либо занимался подобным? Если реализовать задумку на массивах или как либо по другому - сколько примерно по времени будет происходить обновление данных (перешел на итоговый лист, нажал кнопку - например)? Стоит заморачиваться или ну его - пусть остаются формулы?

Код

Sub о_ч_д()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False
    
    m = 48 'номер строки для выгрузки результатов
    iList = Array("ТАиИ", "ОППР", "ТПКиГС", "ЦВП", "ОЭЗСиКС", "ЛМиС", "ЦНиИО", "АТЦ", "КО", "ТО", "ХЦ", "ХЛ", "ТТЦ", "ЭлТех", "ОТ") 'перечень листов
    For Each el In iList
        If sheetExists(el) Then
           Sheets(el).Select
        End If
    k = 4 'номер столбца для выгрузки результатов
    For j = 32 To 54 Step 2 'двенадцать проходов по столбцам по каждому листу
    x1 = 0 'обнуляем, иначе при следующем проходе будет не верный результат
    x2 = 0
    x3 = 0
    x4 = 0
    x5 = 0
    x6 = 0
    x7 = 0
    x8 = 0
    x9 = 0
    x10 = 0
    x11 = 0
    x12 = 0
    x13 = 0
    x14 = 0
    x15 = 0
    x16 = 0
    x17 = 0
    x18 = 0
    x19 = 0
    x20 = 0
    x21 = 0
    x22 = 0
    x23 = 0
    x24 = 0
    x25 = 0
    x26 = 0
    x27 = 0
    x28 = 0
    x29 = 0
    x30 = 0
    x31 = 0
    x32 = 0
    x33 = 0
    x34 = 0
    x35 = 0
    x36 = 0
    x37 = 0
    x38 = 0
    x39 = 0
    x40 = 0
    y1 = 0
    y2 = 0
    y3 = 0
    y4 = 0
    y5 = 0
    y6 = 0
    y7 = 0
    y8 = 0
    y9 = 0
    y10 = 0
    y11 = 0
    y12 = 0
    y13 = 0
    y14 = 0
    y15 = 0
    y16 = 0
    y17 = 0
    y18 = 0
    y19 = 0
    y20 = 0
    y21 = 0
    y22 = 0
    y23 = 0
    y24 = 0
    y25 = 0
    y26 = 0
    y27 = 0
    y28 = 0
    y29 = 0
    y30 = 0
    y31 = 0
    y32 = 0
    y33 = 0
    y34 = 0
    y35 = 0
    y36 = 0
    y37 = 0
    y38 = 0
    y39 = 0
    y40 = 0
    c21 = 0
    c22 = 0
    c23 = 0
    c24 = 0
    c25 = 0
    c26 = 0
    c27 = 0
    c28 = 0
    c29 = 0
    c30 = 0
    c31 = 0
    c32 = 0
    c33 = 0
    c34 = 0
    c35 = 0
    c36 = 0
    c37 = 0
    c38 = 0
    c39 = 0
    c40 = 0
    a1 = 0
    a2 = 0
    a3 = 0
    a4 = 0
    a5 = 0
    a6 = 0
    a7 = 0
    a8 = 0
    a9 = 0
    a10 = 0
    a11 = 0
    a12 = 0
    a13 = 0
    a14 = 0
    a15 = 0
    a16 = 0
    a17 = 0
    a18 = 0
    a19 = 0
    a20 = 0
    a21 = 0
    a22 = 0
    a23 = 0
    a24 = 0
    a25 = 0
    a26 = 0
    a27 = 0
    a28 = 0
    a29 = 0
    a30 = 0
    a31 = 0
    a32 = 0
    a33 = 0
    a34 = 0
    a35 = 0
    a36 = 0
    a37 = 0
    a38 = 0
    a39 = 0
    a40 = 0
    b1 = 0
    b2 = 0
    b3 = 0
    b4 = 0
    b5 = 0
    b6 = 0
    b7 = 0
    b8 = 0
    b9 = 0
    b10 = 0
    b11 = 0
    b12 = 0
    b13 = 0
    b14 = 0
    b15 = 0
    b16 = 0
    b17 = 0
    b18 = 0
    b19 = 0
    b20 = 0
    b21 = 0
    b22 = 0
    b23 = 0
    b24 = 0
    b25 = 0
    b26 = 0
    b27 = 0
    b28 = 0
    b29 = 0
    b30 = 0
    b31 = 0
    b32 = 0
    b33 = 0
    b34 = 0
    b35 = 0
    b36 = 0
    b37 = 0
    b38 = 0
    b39 = 0
    b40 = 0
    d1 = 0
    d2 = 0
    d3 = 0
    d4 = 0
    d5 = 0
    d6 = 0
    d7 = 0
    d8 = 0
    d9 = 0
    d10 = 0
    d11 = 0
    d12 = 0
    d13 = 0
    d14 = 0
    d15 = 0
    d16 = 0
    d17 = 0
    d18 = 0
    d19 = 0
    d20 = 0
    d21 = 0
    d22 = 0
    d23 = 0
    d24 = 0
    d25 = 0
    d26 = 0
    d27 = 0
    d28 = 0
    d29 = 0
    d30 = 0
    d31 = 0
    d32 = 0
    d33 = 0
    d34 = 0
    d35 = 0
    d36 = 0
    d37 = 0
    d38 = 0
    d39 = 0
    d40 = 0
    
    lRow = Cells(Rows.Count, 2).End(xlUp).Row
    For i = 15 To lRow 'суммирование значений, удовлетворяющих условиям
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ЦТОиПО" Then
    a1 = Cells(i, j).Value
    x1 = x1 + a1
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ЦТОиПО" Then
    b1 = Cells(i, j).Value
    y1 = y1 + b1
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ЦТОиПО" Then
    a2 = Cells(i, j).Value
    x2 = x2 + a2
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ЦТОиПО" Then
    b2 = Cells(i, j).Value
    y2 = y2 + b2
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ЦТОиПО" Then
    a3 = Cells(i, j).Value
    x3 = x3 + a3
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ЦТОиПО" Then
    b3 = Cells(i, j).Value
    y3 = y3 + b3
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ЦТОиПО" Then
    a4 = Cells(i, j).Value
    x4 = x4 + a4
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ЦТОиПО" Then
    b4 = Cells(i, j).Value
    y4 = y4 + b4
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ИЭСвп" Then
    a5 = Cells(i, j).Value
    x5 = x5 + a5
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ИЭСвп" Then
    b5 = Cells(i, j).Value
    y5 = y5 + b5
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ИЭСвп" Then
    a6 = Cells(i, j).Value
    x6 = x6 + a6
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ИЭСвп" Then
    b6 = Cells(i, j).Value
    y6 = y6 + b6
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ИЭСвп" Then
    a7 = Cells(i, j).Value
    x7 = x7 + a7
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ИЭСвп" Then
    b7 = Cells(i, j).Value
    y7 = y7 + b7
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ИЭСвп" Then
    a8 = Cells(i, j).Value
    x8 = x8 + a8
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ИЭСвп" Then
    b8 = Cells(i, j).Value
    y8 = y8 + b8
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ИЭСсп" Then
    a9 = Cells(i, j).Value
    x9 = x9 + a9
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ИЭСсп" Then
    b9 = Cells(i, j).Value
    y9 = y9 + b9
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ИЭСсп" Then
    a10 = Cells(i, j).Value
    x10 = x10 + a10
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ИЭСсп" Then
    b10 = Cells(i, j).Value
    y10 = y10 + b10
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ИЭСсп" Then
    a11 = Cells(i, j).Value
    x11 = x11 + a11
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ИЭСсп" Then
    b11 = Cells(i, j).Value
    y11 = y11 + b11
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ИЭСсп" Then
    a12 = Cells(i, j).Value
    x12 = x12 + a12
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ИЭСсп" Then
    b12 = Cells(i, j).Value
    y12 = y12 + b12
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ВП" Then
    a13 = Cells(i, j).Value
    x13 = x13 + a13
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ВП" Then
    b13 = Cells(i, j).Value
    y13 = y13 + b13
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ВП" Then
    a14 = Cells(i, j).Value
    x14 = x14 + a14
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ВП" Then
    b14 = Cells(i, j).Value
    y14 = y14 + b14
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ВП" Then
    a15 = Cells(i, j).Value
    x15 = x15 + a15
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ВП" Then
    b15 = Cells(i, j).Value
    y15 = y15 + b15
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ВП" Then
    a16 = Cells(i, j).Value
    x16 = x16 + a16
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ВП" Then
    b16 = Cells(i, j).Value
    y16 = y16 + b16
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ЛСЭ" Then
    a17 = Cells(i, j).Value
    x17 = x17 + a17
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ЛСЭ" Then
    b17 = Cells(i, j).Value
    y17 = y17 + b17
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ЛСЭ" Then
    a18 = Cells(i, j).Value
    x18 = x18 + a18
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ЛСЭ" Then
    b18 = Cells(i, j).Value
    y18 = y18 + b18
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ЛСЭ" Then
    a19 = Cells(i, j).Value
    x19 = x19 + a19
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ЛСЭ" Then
    b19 = Cells(i, j).Value
    y19 = y19 + b19
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ЛСЭ" Then
    a20 = Cells(i, j).Value
    x20 = x20 + a20
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "д" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ЛСЭ" Then
    b20 = Cells(i, j).Value
    y20 = y20 + b20
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ЦТОиПО" Then
    a21 = Cells(i, j).Value
    x21 = x21 + a21
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ЦТОиПО" Then
    b21 = Cells(i, j).Value
    y21 = y21 + b21
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ЦТОиПО" Then
    c21 = Cells(i, j).Value
    d21 = d21 + c21
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ЦТОиПО" Then
    a22 = Cells(i, j).Value
    x22 = x22 + a22
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ЦТОиПО" Then
    b22 = Cells(i, j).Value
    y22 = y22 + b22
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ЦТОиПО" Then
    c22 = Cells(i, j).Value
    d22 = d22 + c22
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ЦТОиПО" Then
    a23 = Cells(i, j).Value
    x23 = x23 + a23
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ЦТОиПО" Then
    b23 = Cells(i, j).Value
    y23 = y23 + b23
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ЦТОиПО" Then
    c23 = Cells(i, j).Value
    d23 = d23 + c23
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ЦТОиПО" Then
    a24 = Cells(i, j).Value
    x24 = x24 + a24
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ЦТОиПО" Then
    b24 = Cells(i, j).Value
    y24 = y24 + b24
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ЦТОиПО" Then
    c24 = Cells(i, j).Value
    d24 = d24 + c24
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ИЭСвп" Then
    a25 = Cells(i, j).Value
    x25 = x25 + a25
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ИЭСвп" Then
    b25 = Cells(i, j).Value
    y25 = y25 + b25
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ИЭСвп" Then
    c25 = Cells(i, j).Value
    d25 = d25 + c25
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ИЭСвп" Then
    a26 = Cells(i, j).Value
    x26 = x26 + a26
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ИЭСвп" Then
    b26 = Cells(i, j).Value
    y26 = y26 + b26
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ИЭСвп" Then
    c26 = Cells(i, j).Value
    d26 = d26 + c26
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ИЭСвп" Then
    a27 = Cells(i, j).Value
    x27 = x27 + a27
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ИЭСвп" Then
    b27 = Cells(i, j).Value
    y27 = y27 + b27
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ИЭСвп" Then
    c27 = Cells(i, j).Value
    d27 = d27 + c27
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ИЭСвп" Then
    a28 = Cells(i, j).Value
    x28 = x28 + a28
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ИЭСвп" Then
    b28 = Cells(i, j).Value
    y28 = y28 + b28
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ИЭСвп" Then
    c28 = Cells(i, j).Value
    d28 = d28 + c28
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ИЭСсп" Then
    a29 = Cells(i, j).Value
    x29 = x29 + a29
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ИЭСсп" Then
    b29 = Cells(i, j).Value
    y29 = y29 + b29
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ИЭСсп" Then
    c29 = Cells(i, j).Value
    d29 = d29 + c29
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ИЭСсп" Then
    a30 = Cells(i, j).Value
    x30 = x30 + a30
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ИЭСсп" Then
    b30 = Cells(i, j).Value
    y30 = y30 + b30
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ИЭСсп" Then
    c30 = Cells(i, j).Value
    d30 = d30 + c30
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ИЭСсп" Then
    a31 = Cells(i, j).Value
    x31 = x31 + a31
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ИЭСсп" Then
    b31 = Cells(i, j).Value
    y31 = y31 + b31
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ИЭСсп" Then
    c31 = Cells(i, j).Value
    d31 = d31 + c31
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ИЭСсп" Then
    a32 = Cells(i, j).Value
    x32 = x32 + a32
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ИЭСсп" Then
    b32 = Cells(i, j).Value
    y32 = y32 + b32
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ИЭСсп" Then
    c32 = Cells(i, j).Value
    d32 = d32 + c32
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ВП" Then
    a33 = Cells(i, j).Value
    x33 = x33 + a33
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ВП" Then
    b33 = Cells(i, j).Value
    y33 = y33 + b33
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ВП" Then
    c33 = Cells(i, j).Value
    d33 = d33 + c33
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ВП" Then
    a34 = Cells(i, j).Value
    x34 = x34 + a34
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ВП" Then
    b34 = Cells(i, j).Value
    y34 = y34 + b34
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ВП" Then
    c34 = Cells(i, j).Value
    d34 = d34 + c34
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ВП" Then
    a35 = Cells(i, j).Value
    x35 = x35 + a35
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ВП" Then
    b35 = Cells(i, j).Value
    y35 = y35 + b35
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ВП" Then
    c35 = Cells(i, j).Value
    d35 = d35 + c35
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ВП" Then
    a36 = Cells(i, j).Value
    x36 = x36 + a36
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ВП" Then
    b36 = Cells(i, j).Value
    y36 = y36 + b36
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ВП" Then
    c36 = Cells(i, j).Value
    d36 = d36 + c36
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ЛСЭ" Then
    a37 = Cells(i, j).Value
    x37 = x37 + a37
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ЛСЭ" Then
    b37 = Cells(i, j).Value
    y37 = y37 + b37
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "опд" And Cells(i, 24).Value = "ЛСЭ" Then
    c37 = Cells(i, j).Value
    d37 = d37 + c37
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ЛСЭ" Then
    a38 = Cells(i, j).Value
    x38 = x38 + a38
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ЛСЭ" Then
    b38 = Cells(i, j).Value
    y38 = y38 + b38
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "т2" And Cells(i, 24).Value = "ЛСЭ" Then
    c38 = Cells(i, j).Value
    d38 = d38 + c38
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ЛСЭ" Then
    a39 = Cells(i, j).Value
    x39 = x39 + a39
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ЛСЭ" Then
    b39 = Cells(i, j).Value
    y39 = y39 + b39
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "то" And Cells(i, 24).Value = "ЛСЭ" Then
    c39 = Cells(i, j).Value
    d39 = d39 + c39
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "*" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ЛСЭ" Then
    a40 = Cells(i, j).Value
    x40 = x40 + a40
    Else
    If Cells(i, 17).Value > 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ЛСЭ" Then
    b40 = Cells(i, j).Value
    y40 = y40 + b40
    Else
    If Cells(i, 17).Value = 0 And Cells(i, 18).Value > 0 And Cells(i + 2, 1).Value = "ч" And Cells(i, 28).Value = "ид" And Cells(i, 24).Value = "ЛСЭ" Then
    c40 = Cells(i, j).Value
    d40 = d40 + c40
    
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    Next
    Z1 = 0 'обнуляем, иначе при следующем проходе будет не верный результат
    Z2 = 0
    Z3 = 0
    Z4 = 0
    Z5 = 0
    Z6 = 0
    Z7 = 0
    Z8 = 0
    Z9 = 0
    Z10 = 0
    Z11 = 0
    Z12 = 0
    Z13 = 0
    Z14 = 0
    Z15 = 0
    Z16 = 0
    Z17 = 0
    Z18 = 0
    Z19 = 0
    Z20 = 0
    Z21 = 0
    Z22 = 0
    Z23 = 0
    Z24 = 0
    Z25 = 0
    Z26 = 0
    Z27 = 0
    Z28 = 0
    Z29 = 0
    Z30 = 0
    Z31 = 0
    Z32 = 0
    Z33 = 0
    Z34 = 0
    Z35 = 0
    Z36 = 0
    Z37 = 0
    Z38 = 0
    Z39 = 0
    Z40 = 0
    Z1 = x1 + y1 'запоминаем полученные результаты
    Z2 = x2 + y2
    Z3 = x3 + y3
    Z4 = x4 + y4
    Z5 = x5 + y5
    Z6 = x6 + y6
    Z7 = x7 + y7
    Z8 = x8 + y8
    Z9 = x9 + y9
    Z10 = x10 + y10
    Z11 = x11 + y11
    Z12 = x12 + y12
    Z13 = x13 + y13
    Z14 = x14 + y14
    Z15 = x15 + y15
    Z16 = x16 + y16
    Z17 = x17 + y17
    Z18 = x18 + y18
    Z19 = x19 + y19
    Z20 = x20 + y20
    Z21 = x21 + y21 + d21
    Z22 = x22 + y22 + d22
    Z23 = x23 + y23 + d23
    Z24 = x24 + y24 + d24
    Z25 = x25 + y25 + d25
    Z26 = x26 + y26 + d26
    Z27 = x27 + y27 + d27
    Z28 = x28 + y28 + d28
    Z29 = x29 + y29 + d29
    Z30 = x30 + y30 + d30
    Z31 = x31 + y31 + d31
    Z32 = x32 + y32 + d32
    Z33 = x33 + y33 + d33
    Z34 = x34 + y34 + d34
    Z35 = x35 + y35 + d35
    Z36 = x36 + y36 + d36
    Z37 = x37 + y37 + d37
    Z38 = x38 + y38 + d38
    Z39 = x39 + y39 + d39
    Z40 = x40 + y40 + d40
    
    Sheets("Бюджет").Select
    
    Cells(m, k).Value = Z1 'выгружаем полученные результаты
    Cells(m + 1, k).Value = Z2
    Cells(m + 2, k).Value = Z3
    Cells(m + 3, k).Value = Z4
    Cells(m + 4, k).Value = Z5
    Cells(m + 5, k).Value = Z6
    Cells(m + 6, k).Value = Z7
    Cells(m + 7, k).Value = Z8
    Cells(m + 8, k).Value = Z9
    Cells(m + 9, k).Value = Z10
    Cells(m + 10, k).Value = Z11
    Cells(m + 11, k).Value = Z12
    Cells(m + 12, k).Value = Z13
    Cells(m + 13, k).Value = Z14
    Cells(m + 14, k).Value = Z15
    Cells(m + 15, k).Value = Z16
    Cells(m + 16, k).Value = Z17
    Cells(m + 17, k).Value = Z18
    Cells(m + 18, k).Value = Z19
    Cells(m + 19, k).Value = Z20
    'пропускаем строку
    Cells(m + 21, k).Value = Z21
    Cells(m + 22, k).Value = Z22
    Cells(m + 23, k).Value = Z23
    Cells(m + 24, k).Value = Z24
    Cells(m + 25, k).Value = Z25
    Cells(m + 26, k).Value = Z26
    Cells(m + 27, k).Value = Z27
    Cells(m + 28, k).Value = Z28
    Cells(m + 29, k).Value = Z29
    Cells(m + 30, k).Value = Z30
    Cells(m + 31, k).Value = Z31
    Cells(m + 32, k).Value = Z32
    Cells(m + 33, k).Value = Z33
    Cells(m + 34, k).Value = Z34
    Cells(m + 35, k).Value = Z35
    Cells(m + 36, k).Value = Z36
    Cells(m + 37, k).Value = Z37
    Cells(m + 38, k).Value = Z38
    Cells(m + 39, k).Value = Z39
    Cells(m + 40, k).Value = Z40
    k = k + 3
    If j <> 54 Then
    Sheets(el).Select
    End If
    Next
    m = m + 44
    Next
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
End Sub
Public Function sheetExists(name As Variant) As Boolean
    On Error GoTo notFound
    test = ActiveWorkbook.Sheets(name).name
    If test <> "" Then
        sheetExists = True
        Exit Function
    End If
notFound:
    sheetExists = False
End Function

Перейти

Абсолютные и относительные ссылки в формулах, прописываемых макросом.

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

16.04.2018 08:53:15

Доброе утро.
Макросом проставляю формулу:

Код
Cells(a, 17).FormulaR1C1 = "=SUM(R[1]C:R" & b & "C)"

Получается формула со знаком доллара:

Код
=СУММ(Q16:Q$22)

Мне нужно без этого знака.
Пробовал так:

Код
Cells(a, 17).FormulaR1C1 = "=SUM(R[1]C:R[" & b & "]C)"

получается:

Код
=СУММ(Q16:Q37)

т.е. некорректный нижний предел.
Не пойму как правильно проставить квадратные скобки.
Прошу помощи.

Перейти

Использование в формуле, прописываемой макросом, не ссылки на ячейку, а её значение.

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

03.04.2018 09:05:16

Добрый день.
Есть макрос который прописывает формулу в активной ячейке. Формула ссылается на значение отдельной ячейки:

Код
ActiveCell.FormulaR1C1 = "=IF(R1C6=""а"",1,0)"

В результате неравного боя с юзерами появилась необходимость в формуле ссылаться не на ячейку а на её значение:

Код
ActiveCell.FormulaR1C1 = "=IF(R1C6=" & Cells(1, 6).Value & ",1,0)"

Но тут возникла проблема: в формуле прописывается =а, а нужно ="а".
Пытался лепить кавычки, но не получилось.
Как выйти из сложившейся ситуации?
Спасибо.

Перейти

Динамическое определение числового формата ячейки.

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

01.04.2018 19:16:55

Добрый вечер.
Что бы подсветить ячейки имеющие числовой формат с помощью правил УФ использую формулу УФ: =ЯЧЕЙКА("формат";E2)="F0".
Но дело в том что F0 - это нет нулей после запятой, F1 - один ноль после запятой и т.д.
Т.е. на каждый ноль надо писать свою формулу и делать несколько правил УФ.
Пробовал =ЯЧЕЙКА("формат";E2)="F*" и так =ЯЧЕЙКА("формат";E2)="F"&"*" что бы сделать одно универсальное правило УФ для всех ячеек с числовым форматом - не получилось.
Просветите пожалуйста.

P.S. Модераторам: если не правильное название темы - то: универсальное правило УФ для для ячеек с числовым форматом.

Перейти

Частичная отработка макроса на вставку/удаление сток если макрос сделать "Private".

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

19.01.2018 14:16:09

Добрый день.
На данном форуме находил много макросов на втавку/удаление строк. Всё работает отлично. Но если перед Sab добавить Private (что бы название макроса не отображалось в списке макросов) то макрос перестаёт вставлять строчку, хотя с ячейками что-то делает. Например (извиняюсь перед автором не смог найти тему, хотя она была недавно):

Код

Sub Li()
  ActiveCell.EntireRow.Copy
  Rows(ActiveCell.Row + 1).Insert
  With Rows(ActiveCell.Row + 1)
    Intersect(.Cells, range("AD:AF,AJ:AJ,AH:AH,AL:AQ,AS:AS")).ClearContents
    .Interior.ColorIndex = xlColorIndexNone
  End With
  Application.CutCopyMode = False
End Sub

Так вот: хоть макрос находится в модуле, хоть в модуле листа при добавлении Private перестаёт работать.
Как обойти данную проблему?

Перейти

Показать/скрыть столбцы без условия

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

07.12.2017 14:06:22

Добрый день.
Есть макрос который вставляет строку в выбранном месте и вставляет все данные (формулы, УФ, и т.д.) из нижней строчки.
Если выбран фильтр - макрос работает нормально. Если есть скрытые столбцы но не активен фильтр - тоже нормально. А вот если выбран и фильтр и есть скрытые столбцы, то макрос вылетает с ошибкой "данная команда не применима для несмежных диапазонов".
Попробовал добавить "on error resume next" - строка вставляется, но без данных из нижней строки, что неприемлемо.
Попробовал применить следующую логику: перед работой макрос запоминает какие столбцы были скрыты и после выполнения основной части опять скрывает эти столбцы.
Смотрел здесь:
http://www.planetaexcel.ru/techniques/9/121/
http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=8&TID=22487
но у меня обратная задача и без дополнительных условий.
Сделал насколько соображаю:

Код

Sub Ìàêðîñ1()
'
    Dim i As Range
    Dim a As Range
    For Each i In [A:BN]
    If iEntireColumn.Hidden = True Then
    a(i) = 0
    Else
    End If
    Next
    ActiveSheet.UsedRange.EntireColumn.Hidden = False
    ''''''''
    For Each i In [A:BN]
    If a(i) = 0 Then
    iEntireColumn.Hidden = False
    Else
    End If
    Next
End Sub

но данная конструкция не работает, вылетает с ошибкой "Object requierd" на первом If.
Должно быть: перед работой макрос запоминает какие столбцы были скрыты и после выполнения основной части опять скрывает эти столбцы.
Прошу помощи.

Перейти

Работать макросом только с нужными листами книги

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

19.10.2017 13:59:31

Добрый день.
Замучался.
Не нашёл ничего подходящего (хотя встречал здесь).
Суть: необходимо работать не со всеми листами книги, а с отдельными.
Помогите пожалуйста организовать приведённое ниже безобразие в цикл.

Код

Sub сбор_всех_листов_на_один_лист_ОСО()
'http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=96981&TITLE_SEO=96981-makros-sbora-vsekh-listov-v-odin-list-nuzhna-korrektsiya
        
    'iList = Array("ТАиИ", "ОППР", "ТПКиГС", "ЦВП", "ОЭЗСиКС", "ЛМиС", "ЦНиИО", "АТЦ", "КО", "ТО", "ХЦ", "ХЛ", "ЭлТех", "ОТ", "ИТОГ", "ТМЦ")
    For Each sht In Worksheets
        If sht.Name = "ТАиИ" Then
           myR_Total = Sheets("Инструкция").Range("L" & Sheets("Инструкция").Rows.Count).End(xlUp).Row + 1
           myR_i = Sheets("ТАиИ").Range("L" & Sheets("ТАиИ").Rows.Count).End(xlUp).Row
 
           If i = 1 Then
            Sheets("ТАиИ").Rows("1:" & myR_i).Copy Sheets("Инструкция").Range("A" & myR_Total)
           Else
            Sheets("ТАиИ").Rows("2:" & myR_i).Copy Sheets("Инструкция").Range("A" & myR_Total)
           End If
        End If
        
        If sht.Name = "ОППР" Then
           myR_Total = Sheets("Инструкция").Range("L" & Sheets("Инструкция").Rows.Count).End(xlUp).Row + 1
           myR_i = Sheets("ОППР").Range("L" & Sheets("ОППР").Rows.Count).End(xlUp).Row
 
           If i = 1 Then
            Sheets("ОППР").Rows("1:" & myR_i).Copy Sheets("Инструкция").Range("A" & myR_Total)
           Else
            Sheets("ОППР").Rows("2:" & myR_i).Copy Sheets("Инструкция").Range("A" & myR_Total)
           End If
        End If
        
        If sht.Name = "ТПКиГС" Then
           myR_Total = Sheets("Инструкция").Range("L" & Sheets("Инструкция").Rows.Count).End(xlUp).Row + 1
           myR_i = Sheets("ТПКиГС").Range("L" & Sheets("ТПКиГС").Rows.Count).End(xlUp).Row
 
           If i = 1 Then
            Sheets("ТПКиГС").Rows("1:" & myR_i).Copy Sheets("Инструкция").Range("A" & myR_Total)
           Else
            Sheets("ТПКиГС").Rows("2:" & myR_i).Copy Sheets("Инструкция").Range("A" & myR_Total)
           End If
        End If
        ........

Изменено: mamalot - 19.10.2017 14:05:30

Перейти

Макрос не вставляет формулу сумма, в диапазонах по условию в составе других функций

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

04.10.2017 09:29:36

Добрый день.
На просторах Планеты (не помню где) находил тему: необходимо прописать формулу СУММ(А1:А15) макросом по условию (если содержится число в определённом столбике).
Адаптировал макрос под себя и всё было хорошо, пока не возникла потребность прописывать формулу СУММ(А1:А15) макросом в составе других функций.

Код
a.Cells(1).Offset(-1, 8).Formula = "=IF(AND(RC17=0,R[2]C1=""д"",R1C1=1),R[1]C1,Sum(" & a.Offset(, 8).Address & "))"

Так не вставляется вообще.

Код
a.Cells(1).Offset(-1, 8).Formula = "=IF(AND(RC17=0,R[2]C1=""д"",R1C1=1),R[1]C1,SUM(R[1]C:R[7]C))"

Так - нормально.

Весь код:

Код

Sub правильные_формулы_СП()
Application.ScreenUpdating = False
    
    Dim b As Range: On Error Resume Next
    [y:y].SpecialCells(15, 25).Offset(, -8).ClearContents
    For Each a In [y:y].SpecialCells(4).Areas
        a.Cells(1).Offset(-1, -8).Formula = "=Sum(" & a.Offset(, -8).Address & ")"
        
        If a.Cells(1).Offset(-1, 7).Value > 0 Then
        a.Cells(1).Offset(-1, 7).Formula = "=IF(AND(RC17=0,R[2]C1=""ч"",R1C1=1),R[1]C1,IF(RC17>0,R[1]C1,0))"
        a.Cells(1).Offset(-1, 8).Select
        a.Cells(1).Offset(-1, 8).Formula = "=IF(AND(RC17=0,R[2]C1=""д"",R1C1=1),R[1]C1,Sum(" & a.Offset(, 8).Address & "))"
        'ПРЕДЫДУЩАЯ ФОРМУЛА НЕ ВСТВЛЯЕТСЯ, А СЛЕДУЮЩАЯ, ЕСЛИ РАСКОММЕНТИРОВАТЬ-ДА
        'a.Cells(1).Offset(-1, 8).Formula = "=IF(AND(RC17=0,R[2]C1=""д"",R1C1=1),R[1]C1,SUM(R[1]C:R[7]C))"
        End If
    Next
    
End Sub

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

Думаю проблема либо в грамматике либо в принципе - солидола в голове не хватает.
Прошу помощи разобраться с данной проблемой.

Перейти

Замена множества вложенных функций "ЕСЛИ", не макросом; не формулой массива.

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

25.08.2017 14:59:44

Добрый день.
Возникла необходимость заменить работу макроса на формулу. Получилась формула с 12-ю вложенными "ЕСЛИ".
Но в связи с разными версиями установленного офиса на рабочих машинах - теперь необходимо избавиться от множества вложенных "ЕСЛИ".

Код

=ИНДЕКС(ЕСЛИ(AF3>0;Лист2!$G$2:$G$3;ЕСЛИ(AH3>0;Лист2!$H$2:$H$3;ЕСЛИ(AJ3>0;Лист2!$I$2:$I$3;ЕСЛИ(AL3>0;Лист2!$J$2:$J$3;ЕСЛИ(AN3>0;Лист2!$K$2:$K$3;
ЕСЛИ(AP3>0;Лист2!$L$2:$L$3;ЕСЛИ(AR3>0;Лист2!$M$2:$M$3;ЕСЛИ(AT3>0;Лист2!$N$2:$N$3;ЕСЛИ(AV3>0;Лист2!$O$2:$O$3;ЕСЛИ(AX3>0;Лист2!$P$2:$P$3;
ЕСЛИ(AZ3>0;Лист2!$Q$2:$Q$3;ЕСЛИ(BB3>0;Лист2!$R$2:$R$3;Лист2!$F$2:$F$3))))))))))));ПОИСКПОЗ(Лист1!L3;Лист2!$A$2:$A$3;0))

Получается: по уникальному номеру необходимо найти и подтянуть цену со второго листа соответственно требуемого месяца. Т.е. если на первом листе AN3>0 (строка 3) то со второго листа подтягиваем значение из K3.
Возможно ли это и если ДА то как?

Перейти

Название листа книги в формуле ИНДЕКС(ПОИСКПОЗ)

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

16.07.2017 16:09:03

Добрый день.
Имеется книга в которой шесть листов имеют одинаковую структуру и седьмой лист с данными (материалы).
С помощью формулы:

Код

=ИНДЕКС(материалы!$C$2:$C$32839;ПОИСКПОЗ('БЛ 9'!L16;материалы!$A$2:$A$32839;0))
=ИНДЕКС(материалы!$C$2:$C$32839;ПОИСКПОЗ('БЛ 10'!L16;материалы!$A$2:$A$32839;0))
=ИНДЕКС(материалы!$C$2:$C$32839;ПОИСКПОЗ('БЛ 11'!L16;материалы!$A$2:$A$32839;0))

осуществляется поиск материала по уникальному коду (ячейка L16) на седьмом листе (материалы) и подтягивается на лист БЛ... название материала.

В одних и тех же ячейках разных листов (например в ячейке L26) могут содержаться как разные так и одинаковые уникальные коды.

Вопрос: насколько необходимо прописывать в формулах название листов?

Пробовал и так и так - разницы вроде бы нет, но файл очень серьёзный - не хочется накосячить!

Перейти

Изменение координат коментариев

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

21.06.2017 10:15:05

Добрый день.
Есть макрос который устанавливает комментарий на ячейку в которой производятся изменения.
При этом получается вот такая картина:
То есть: комментарий устанавливается но когда отображаешь все комментарии - они расположены хаотично по листу.
Почему так происходит-не пойму.
Вопрос: как выровнять комментарии справа от ячейки???
Например макрос записанный марккордером:

Код
Sub Ìàêðîñ1() ' ' Ìàêðîñ1 Ìàêðîñ '' Range("X13").Comment.Shape.Select True Selection.ShapeRange.IncrementLeft -8.5 'Selection.ShapeRange.IncrementTop 163.5 End Sub

Но во второй строчке необходимо прописывать на сколько он должен сместиться а комменарий может быть от ячейки его содержащий на другом конце листа?

Перейти

Отследить событие "вставить" в ячейке/диапазоне листа/книги и вставить только значение

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

24.05.2017 14:57:02

Добрый день.
Возникла необходимость защититься от некорректной вставки значений в ячейки/диапазон. То есть: пользователь вставляет в ячейку/диапазон скопированные данные как Paste и вместе с данными вставляется скопированный формат и т.д. А необходимо чтобы вставка происходила как PasteSpecial.
Порывшись на просторах - решил проблему вставки через Ctrl+V:

Код

Sub Макрос1()
'
' Макрос1 Макрос
'
' Сочетание клавиш: Ctrl+м
'
    On Error Resume Next
  Selection.PasteSpecial Paste:=xlValues
  If Err Then Err.Clear: ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Но не смог решить: если пользователь нажал правую кнопку мышки и для вставки выбрал "вставить(Ь)" или из буфера обмена "вставить(Ь)".
Прошу помощи в данном вопросе.

Перейти

Макрос некорректно осуществляет сбор информации.

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

17.05.2017 08:26:58

Добрый день.
Прошу совета/консультации.
Есть файл о семи листах. Макросом с них собираю необходимую информацию на восьмой лист. Если фильтры на всех листах сняты-отрабатывает нормально. Но если на листах отфильтрована информация по каким-либо значениям - макрос отрабатывает некорректно.
Вопрос: для корректной работы макроса необходимо следить чтобы фильтры были сняты или это можно как-то победить?

Перейти

Линейный график выполнения работ круглосуточный (в три смены).

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

26.04.2017 16:51:16

Добрый день.
Задался целью сделать в экселе линейный график выполнения работ в одну (дневную) смену с учётом/без учёта выходных и праздников, с запаздыванием в ту или иную сторону - сделал.
Решил сотворить линейный график выполнения работ в три смены (круглосуточно). И тут началось.
График получился, но запаздывание только в положительную сторону, совсем не представляю как сделать с учётом/без учёта выходных и праздников, больше 23 смен не поставишь.
Перерыл пол интернета. Вторую неделю бьюсь.
Прошу помощи, пожалуйста.
Архив во вложении.

Перейти

Склеивание текста из ячеек., Склеивание текста из ячеек построчно из выделенного диапазона в определённой последовательности без объединения ячеек.

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

23.03.2017 17:47:19

Доброго времени суток.
Необходимо склеить текст из ячеек выделенного диапазона в - определённой последовательности - без объединения этих ячеек - с выводом склеенного текста в ячейку сверху выделенного диапазона - с проверкой условия.
Долго искал на просторах интернета, но подходящего так и не нашёл.
Выделенный диапазон:B2:D6.

Изменено: mamalot - 23.03.2017 17:56:02

Перейти

Перемещение формул в диапазоне в зависимости от значения ячейки.

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

14.03.2017 16:52:15

Доброго времени суток.
Задался вопросом: как сделать чтобы в зависимости от значения ячейки (ячейка соответствует своему диапазону) формулы перемещались в нужное место диапазона.
Самостоятельные изыскания не принесли желаемого результата.
Прошу помочь.
Более подробное описание в файле во вложении.
Спасибо.

Перейти

Сортировка уникальных данных в выбранном диапазоне, Как отсортировать данные в столбике "А" при этом привязать к ним данные из столбика "D"

Пользователь

Сообщений: 136 Регистрация: 24.02.2017

24.02.2017 20:36:26

Доброго времени суток. Прошу Вашей помощи начинающему. Имею скромные познания VBA. Но имеющиеся знания не позволяют решить следующую проблему: необходимо произвести сортировку данных при этом вместе с перемещением числа в столбце "А" должны перемещаться и данные из столбца "D". Файл во вложении. Первый раз здесь. Поэтому прошу прощения за свою косолапость.

Перейти

Наверх