Друзья, может помочь кто-нибудь подправить макрос ?

Михаил Лебедев, спасибо огромное, очень клева получилось. Моих знаний точно не хватит такой написать. Вы большой молодец!!!

Еще маленькая просьба, подправить код, чтобы листы сохранялись в один PDF, без МО и ПО в конце. Два направления в одном файле PDF.
Условия такие же если "v", то 2 направления, если "0" то 1.

Пример: 703 Петров П.И.pdf

Еще раз огромное спасибо, за оказанную помощь!!!

Михаил Лебедев, спасибо огромное за оказанную помощь.

Но получается, макрос не срабатывает как нужно.

Во вложенном файле, макрос Naprav1, проверяет в столбце А, наличие плюса и сохраняет пдф, и проверяет следующую строку.
В итоге получается два пдф файла направления 1. Далее плюсы удаляются.

В Вашем варианте получается нет цикла, т.е. он сохраняет вариант из первой строки. и дальше не идет.
Также заметил при добавлении 3 строки, с наличием V, сохраняется только направление 1.
Также, так как направления 2 штуки, нужно им присвоить разные имена при сохранении, Направление 1 в конце МО, направление 2 в конце ПО.

Может я неправильно описал то что нужно в итоге(.

Таблица наполняется данными на листе Заполнить, при помощи ВПР переносятся значения в листы с направлениями, для этого мы и ставим + в столбце A.
Макрос проверяет наличие "+" в ячейке А2, если  "+" есть данные вставляются на листы Направление 1 и 2, через ВПР.
Далее сохраняет в пдф направление 1 формате 703 Петров П.И. МО
Далее проверяет наличие  "v" в ячейке J2, если стоит значит сохраняет направление 2, с именем 703 Петров П.И. ПО.
Далее удаляет "+" в ячейке А2.
И проверяет следующие ячейки соответственно A3 и J3, и так далее. Просто если не удалить "+" в предыдущей ячейке, через ВПР данные не подставятся со следующей строки.

В принципе можно обойтись и без +, но я не знаю как. В голову пришло только такое решения для заполнения направлений.

Сможете подправить код?

Огромное спасибо ВАМ.

Пример бы добавили

Добрый день. Немало времени провел на форуме, в поисках ответа на свой вопрос, который удалось решить лишь частично. Необходимо доработать макрос который бы проверял стоят ли значения в разных столбцах, и сохранял файлы в пдф но с разными именами.

Sub Naprav2()

Если в A2 стоит "+", а в J2 "v" то сохраняем направление 1 и направление 2.
Если в A2 стоит "+", а в J2 "0" то сохраняем направление 1.

И так далее A3....A20, J3....J20


Уже всю голову сломал что и куда нужно вставить.

Заранее благодарен.

Вообщем решил вопрос такой формулой =И(B3+B$2<=СЕГОДНЯ()-1;B3+B$2>=СЕГОДНЯ()-19)

Павел с Востока а подскажите еще пожалуйста, какую формулу использовать чтобы ячейка окрашивалась в желтый цвет, но только за 20 дней,  

Павел с Востока спасибо огромное, данный метод действительно простой и работает.
Посмотрел на формулу и подумал что она не подойдет.

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

Ігор Гончаренко Спасибо, за ответ, но в вашем примере не учитывается, что в ячейке С2, уже другое количество дней.
Я не один веду этй таблицу и там намного больше данных, чем в примере.
При копировании даты из других ячеек условное форматирование перестает конкретно работать.
По этому решил спросить про макрос который никто никогда не сломает)

Павел с Востока Спасибо, за ответ, но в этом случае как учитывать что в ячейке С2, уже другое количество дней.

Получается, когда копируешь ячейку в соседнюю, условное форматирование также копируется и получается как здесь
Ад Условного Форматирования (planetaexcel.ru)

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

Допусти Иванов получил шапку 01.02.2021 года, срок носки составляет 730 дней, сегодня 01.04.2023. Значит он уже ей пользуется 788 дней.
Следовательно красим значение в ячейке B2 в красный цвет.

И тд.

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

Спасибо.

Спасибо, огромное очень помогли

Выложил

В столбце A, есть несколько значений, в столбце B есть также критерии, нужно посчитать количество значений ON, на каждый день, с учетом столбца A и B.

Нужно посчитать значения ON, с учетом двух разных значений в столбце A и Б. Результат вывести внизу таблицы.

Всем привет, как можно сократить формулу, так как строк в таблице больше 1000

=СЧЁТЕСЛИМН(AB$8:AB$990;"ON";$G$8:$G$990;$G$1010;$N$8:$N$990;Лист1!$A$2)+СЧЁТЕСЛИМН(AB$8:AB$990;"ON";$G$8:$G$990;$G$1010;$N$8:$N$990;Лист1!$A$3)+СЧЁТЕСЛИМН(AB$8:AB$990;"ON";$G$8:$G$990;$G$1010;$N$8:$N$990;Лист1!$A$4)+СЧЁТЕСЛИМН(AB$8:AB$990;"ON";$G$8:$G$990;$G$1010;$N$8:$N$990;Лист1!$A$5)+СЧЁТЕСЛИМН(AB$8:AB$990;"ON";$G$8:$G$990;$G$1010;$N$8:$N$990;Лист1!$A$6)+СЧЁТЕСЛИМН(AB$8:AB$990;"ON";$G$8:$G$990;$G$1010;$N$8:$N$990;Лист1!$A$7)+СЧЁТЕСЛИМН(AB$8:AB$990;"ON";$G$8:$G$990;$G$1010;$N$8:$N$990;Лист1!$A$8)+СЧЁТЕСЛИМН(AB$8:AB$990;"ON";$G$8:$G$990;$G$1010;$N$8:$N$990;Лист1!$A$9)+СЧЁТЕСЛИМН(AB$8:AB$990;"ON";$G$8:$G$990;$G$1010;$N$8:$N$990;Лист1!$A$10)+СЧЁТЕСЛИМН(AB$8:AB$990;"ON";$G$8:$G$990;$G$1010;$N$8:$N$990;Лист1!$A$11)+СЧЁТЕСЛИМН(AB$8:AB$990;"ON";$G$8:$G$990;$G$1010;$N$8:$N$990;Лист1!$A$12)+СЧЁТЕСЛИМН(AB$8:AB$990;"ON";$G$8:$G$990;$G$1010;$N$8:$N$990;Лист1!$A$13)+СЧЁТЕСЛИМН(AB$8:AB$990;"ON";$G$8:$G$990;$G$1010;$N$8:$N$990;Лист1!$A$14)

Евгений Корнилов, извените не сразу понял как его установить, но вроде получилось. А какие дальнейшие действия нужно выполнить?

evgeniygeo, спасибо огромное попробую, и отпишусь что получилось

Спасибо за ответ. Вариант фильтрации и суммирования действительно работает, но нужно удалить дублирующие строки.

Спасибо, за ответ. Задачу нужно решить макросом, так как надстройки установить нет возможности.

Всем привет.  

Помогите подправить макрос. В таблице нужно оставить определенные столбцы (BCDENP), а остальные удалить. Во вновь полученной таблице сделать сортировку значение, и удалить дублирующие строки в столбце Material, но с суммированием значений из столбцов отдельно для Unrestricted и Blocked. В файле добавил описание. Количество строк может достигать 10000. И если, не сложно описать каждую строку кода для дальнейшего понимания.

Заранее спасибо.

Евгений Смирнов, Mershik, ребята вообще круто, я прям не знаю как выразить свои эмоции, долгих лет вам!!!
СПАСИБО ОГРОМНОЕ

Ребят у меня еще вопрос а можно чтобы диапазон ячеекМожно было прописать вручную в таблице, например 2 это ячейка L5, а 102 это ячейка L6. Данные из этих ячеек подставлялись в код. Спасибо

vikttur, ничего не пойму мне нужно здесь предложить как назвать тему? Предлагаю такую Макрос автоматической печати при условии заполнения ячейки знаком +

vikttur, а как поменять название темы, что то не найду

Евгений Смирнов, спасибо огромное все заработало!! Всем спасибо за участие. Все работает как часики.

Mershik, Плюс ставиться для переноса данных с листа Данные, далее печатается бланк заполненный из строки где стоит +. Дальше макрос должен стереть этот + и поставить в ячейку ниже. Если будет два плюса в одном столбце данные не подставятся на лист Бланк. Просто для переноса данных на лист Бланк я использовал функцию ВПР.

Mershik, мне нужно чтобы макрос подставлял + в ячейку А2 и печатал лист Бланк, далее отчищал ячейку и переходил к следующей А3,
подставлял + в ячейку А3 и печатал лист Бланк, далее отчищал ячейку и переходил к следующей А4 и т.д. Так до 100 ячейки. Пример приложил, спасибо

Евгений, здесь получается просто печать, а мне нужно поставить знак плюс в в ячейки, т.е. сели в ячейке А2 стоит + печатается, дальше + стирается и переходит на следующую ячейку А3 ставится + и т.д.

Всем привет, ребята подскажите пожалуйста как мне проще написать данную команду на 100 ячеек. Спасибо.

Добрый день уважаемые участники форума!!! Хотел попросить у Вас помощи. Так как не особо понимаю в программировании, не смог найти подходящий для себя вариант. Вообщем цель следующая, нужно чтобы при нажатии кнопки Печать (Сохранить в PDF) макрос анализировал установлен ли + напротив строки, если да, то отправлял на печать (сохранял в PDF) лист. Данными из этой строки где установлен +, заполняются строки на листе Бланк ПН. Также хотелось узнать есть ли возможность при печати выбирать какие страницы печатать при определенном условии. Например печатаем страницы 1,2,3 если в ячейке F4 1, или печатаем страницы 2,4,6 если в ячейке F5 2. Заранее благодарен. Пример во вложении.

Вот есть примеры, но я не пойму как их мне отредактировать под свои нужды.

Sub ВPDF()
   Const sPROTOCOL_WSH_NAME As String = "Данные"
   
   With ThisWorkbook.Worksheets(sPROTOCOL_WSH_NAME)
       Dim arr(): arr = .Range("A4:A" & .Cells.SpecialCells(xlCellTypeLastCell).Row).Value
   End With ' ThisWorkbook.Worksheets(sPROTOCOL_WSH_NAME)
   
   Dim i As Long, j As Long: j = UBound(arr, 2)
   Dim aSh(), li As Long
   Dim t As String
   On Error Resume Next
   For i = 1 To UBound(arr, 1)
       If StrComp(arr(i, j), "+", vbTextCompare) = 0 Then
           ReDim Preserve aSh(li)
           aSh(li) = CStr(arr(i, 1))
           li = li + 1
           t = t + " " + CStr(arr(i, 1))
       End If
   Next i
   If li = 0 Then
   MsgBox ("Поставь + в столбец Печать, для сохранения файла!!!!")
   End If
   
      t = "Паспорт" + t
     Worksheets(aSh).Select
      ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
       ThisWorkbook.Path & "\" & t, Quality:=xlQualityStandard, _
       IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
       
   On Error GoTo 0
   Application.StatusBar = False
   Worksheets("Данные").Select
End Sub

Sub Печать1()
   Const sPROTOCOL_WSH_NAME As String = "Данные"
   
   With ThisWorkbook.Worksheets(sPROTOCOL_WSH_NAME)
       Dim arr(): arr = .Range("A6:P" & .Cells.SpecialCells(xlCellTypeLastCell).Row).Value
   End With ' ThisWorkbook.Worksheets(sPROTOCOL_WSH_NAME)
   
   Dim i As Long, j As Long: j = UBound(arr, 2)
   Dim t As Long
   On Error Resume Next
   For i = 1 To UBound(arr, 1)
       If StrComp(arr(i, j), "+", vbTextCompare) = 0 Then
          t = t + 1

           With ThisWorkbook.Worksheets(CStr(arr(i, 1)))
               If Err = 0 Then
                   Application.StatusBar = "Печатаем лист """ & .Name & """"
                   .PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
               Else
                   Err.Clear
               End If ' Err = 0
           End With ' ThisWorkbook.Worksheets(arr(i, 1))
       End If
   Next i
   
   On Error GoTo 0
   Application.StatusBar = False
   If t = 0 Then
   MsgBox ("Поставь + в столбец Печать, для сохранения файла!!!!")
   End If
End Sub