Задача. Нужно найти разницу между датой из ячейки C1 и датой из столбца D и если разница больше чем 10 дней, то данную строку скопировать на Лист 1.
Например, в C1 дата 08.01.2020, в столбце D дата 12.12.2019. Между ними разница 27 дней, то есть больше 10, значит данную строку берем и копируем на Лист1.
Сделал макрос, но он работает на половину:
Макрос
Sub qq()
Dim LastRow As Long, Rw As Long
LastRow = Cells(Rows.Count, 4).End(xlUp).Row
With Sheets("Лист1")
Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = 6 To LastRow
If Cells(i, 4) = "02.12.2019" Then
Range(Cells(i, 2), Cells(i, 6)).Copy .Cells(Rw, 1)
Rw = Rw + 1
End If
Next
End With
End Sub
Я подумал, что можно сделать так, но почему-то не работает:
If (Cells (1,3)-Cells(i,4) )>10 then
Range(Cells(i, 2), Cells(i, 6)).Copy .Cells(Rw, 1)
Rw = Rw + 1
End If
И еще нужно добавить, чтобы данный макрос работал с Листа 1. А то сейчас данный макрос работает только с Листа 2.
[вложение удалено администратором]
Я подставил в макрос вашу идею. На первый взгляд работает:
Макрос
Sub Макрос()
Dim sh_src As Worksheet, lr_src As Long
Dim sh_res As Worksheet, r_res As Long
Dim i As Long
' Отключаем монитор, чтобы ускорить макрос.
' Если много формул, можно ещё отключить формулы.
Application.ScreenUpdating = False
'1. Присваиваем листам имена. Далее в коде будем обращаться к листам по этим именам.
Set sh_src = Worksheets("Лист2")
Set sh_res = ActiveSheet
'2. Поиск последних строк.
' End не ищет в скрытых строках.
lr_src = sh_src.Cells(sh_src.Rows.Count, "D").End(xlUp).Row
r_res = sh_res.Cells(sh_res.Rows.Count, "A").End(xlUp).Row
'3. Поиск и копирование строк.
For i = 6 To lr_src
If (sh_src.Range("C1").Value - sh_src.Cells(i, "D").Value) > 10 Then
r_res = r_res + 1
sh_src.Range(sh_src.Cells(i, 2), sh_src.Cells(i, 6)).Copy sh_res.Cells(r_res, 1)
End If
Next i
'4. Включение монитора и сообщение.
Application.ScreenUpdating = True
MsgBox "Готово.", vbInformation
End Sub
Странно Ваш код работает, а мой нет. Я же проверял.
Очень огромное спасибо, всё работает.