Доброго всем вечера!
может быть оперативно поможет кто
Есть таблица в файле: БЗП(1).xlsx
Вот интересно, он у меня прикрепился Не пойму как это правильно сделать? Когда загружаю файл, стоит значек некорректного файла
Хотелось бы, чтобы получилось два разных макроса:
1 если в строке в столбце 2 пусто, а в 7 нет, то в пустые ячейки внести данные из верхней строки, кроме столбцов 6,7 и 8 (там свои данные), в прикрепленном файле выделено желтой заливкой, то, что должно быть заполнено
2. если в столбце 2 дата меньше, чем текущая, то вся строка с этого листа перемещается на другой лист, например, Удаленные. (то, что должно в примере переместиться выделено зеленой заливкой)
Буду признательна за любую помощь
Предыдущую задачу решила с горем пополам ))), теперь новая ) Тоже вроде бы получилась, но я чайник, поэтому и решение корявое, да еще не корректное. Может подскажет кто где ошибка и "причешет" мой макрос )))
В общем, задача такая - на Листе "Защищенные проекты" есть таблица с данными начиная с 4 строки, столбцов 17, количество строк меняется.
Необходимо проверить все на наличие условий, если в столбце 3 дата меньше текущей (в ячейке Cells(1, 11))или в столбце 11 значение равно "отказались" или "реализован", то такая строка "переносится" полностью на Лист "Архив" в первую пустую строку (проверка заполненности тоже по столбцу 11), в 18 столбце которой вставляется текущая дата переноса информации ( в этом макросе не реализовано).
Цикл проверки останавливается когда на Листе "Защищенные проекты" в столбце11 пусто.
Sub ПереносСтрок()
' переносим строки на лист Архив, если срок защиты истек или статус "Реализован" или "Отказались"
не корректность в том, что не все строки переносит, а только половину, из 10 только первых 5, из 4 первые 2, из 2 только одну(
Мир же не без добрых людей)))
Попробую разобрать
1) Обязательно используйте Option Explicit и обьявляйте переменные
Dim IMAX As Long, JMAX As Long, k As Long, i As Long
2) Вы вводите дополнительный столбец с условием формулой. Я бы не использовал формулы - их сложнее отладить. Или как вариант использовал только формулы.
3) Представленная формула не имеет к заданию отношения. И вдобавок ссылается на неизвестный лист
4) Не используйте в макросах Select, например:
' создаем формулу для удаления строки по условию
IMAX = Sheets("Защищенные проекты").Cells(Rows.Count, 11).End(xlUp).Row
Sheets("Защищенные проекты").Cells(4, 18).FormulaR1C1 = "=IF(OR(RC[-3]=Спр.!R3C12,RC[-3]=Спр.!R4C12),1,"""")"
Sheets("Защищенные проекты").Cells(4, 18).AutoFill Destination:=Sheets("Защищенные проекты").Range(Cells(4, 18), Cells(IMAX, 18))
JMAX = Cells(4, Columns.Count).End(xlToLeft).Column ' не нужная в данном макросе переменная
5) В цикле идёт удаление строк. Строка удаляется - последующие строки спускаются на 1 вниз - необработанная строка замещает обработанную - цикл идёт дальше уже не глядя на строку заменившую обработанную. Выход - идите циклом от конца в начало.
6) ну и копировать надо не по ячейке а диапазоном (или строкой полностью)
k = Sheets("Архив").Cells(Rows.Count, 11).End(xlUp).Row + 1
With Sheets("Защищенные проекты")
For i = IMAX To 4 Step -1
'If .Cells(i, 3) < .Cells(1, 11) Or .Cells(i, 18) = "1" Then
Sheets("Архив").Range(Sheets("Архив").Cells(k, 1), Sheets("Архив").Cells(k, 17)) = .Range(.Cells(i, 1), .Cells(i, 17)).Value
.Rows(i).Delete
k = k + 1
'End If
Next
End With
БОЛЬШОЕ СПАСИБО!!! Выручили!!! Чувствую себя собака: все понимаю, а сказать не могу, вот и понимаю, а языка, кодов не знаю ((( Скачала книгу VBA для чайников, изучаю.
Если интересно, то мой макрос работает вот в таком виде:
Sub ПереносСтрок()
' переносим строки на лист Архив, если срок защиты истек или статус "Реализован" или "Отказались"
' создаем формулу для удаления строки по условию со ссылкой на др. лист
Dim IMAX As Long
Dim k As Long
Dim i As Long
Sheets("Защищённые проекты").Cells(4, 25).Select
ActiveCell.FormulaR1C1 = "=IF(OR(RC[-10]=Спр.!R3C12,RC[-10]=Спр.!R4C12),1,"""")"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A500")
IMAX = Cells(Rows.Count, 11).End(xlUp).Row
k = Sheets("Архив").Cells(Rows.Count, 11).End(xlUp).Row + 1
For i = IMAX To 4 Step -1
If Cells(i, 3) < Cells(1, 11) Or Cells(i, 25) = "1" Then
Sheets("Архив").Range(Sheets("Архив").Cells(k, 1), Sheets("Архив").Cells(k, 17)) = Range(Cells(i, 1), Cells(i, 17)).Value
Rows(i).Delete
k = k + 1
End If
Next
End Sub
Какой он стал красивенький )))
Еще раз, спасибо, доброму человеку!!!
