Как копировать строки и вставлять их на другой лист в Excel на основе даты?
Допустим, у меня есть диапазон данных, и я хочу скопировать всю строку на основе определённой даты, а затем вставить её на другой лист. Есть ли у вас эффективные способы выполнить эту задачу в Excel?
Копирование строк и вставка на другой лист на основе сегодняшней даты
Копирование строк и вставка на другой лист, если дата позже сегодняшней
Копирование строк и вставка на другой лист на основе сегодняшней даты
Если вам нужно скопировать строки, дата в которых соответствует сегодняшней, примените следующий код VBA:
1. Нажмите и удерживайте клавиши ALT + F11, чтобы открыть окно Microsoft Visual Basic для приложений.
2. Нажмите Вставить > Модуль и вставьте следующий код в окно модуля.
Код VBA: копирование и вставка строк на основе сегодняшней даты:
Sub CopyRow()
'Updateby Extendoffice
Dim xRgS As Range, xRgD As Range, xCell As Range
Dim I As Long, xCol As Long, J As Long
Dim xVal As Variant
On Error Resume Next
Set xRgS = Application.InputBox("Please select the date column:", "KuTools For Excel", Selection.Address, , , , , 8)
If xRgS Is Nothing Then Exit Sub
Set xRgD = Application.InputBox("Please select a destination cell:", "KuTools For Excel", , , , , , 8)
If xRgD Is Nothing Then Exit Sub
xCol = xRgS.Rows.Count
Set xRgS = xRgS(1)
Application.CutCopyMode = False
J = 0
For I = 1 To xCol
Set xCell = xRgS.Offset(I - 1, 0)
xVal = xCell.Value
If TypeName(xVal) = "Date" And (xVal <> "") And (xVal = Date) Then
xCell.EntireRow.Copy xRgD.Offset(J, 0)
J = J + 1
End If
Next
Application.CutCopyMode = True
End Sub
3. После вставки приведённого выше кода нажмите клавишу F5, чтобы запустить его. Появится диалоговое окно с запросом выбрать столбец с датами, на основе которого нужно скопировать строки (см. скриншот).
4. Затем нажмите кнопку ОК. В следующем диалоговом окне выберите ячейку на другом листе, куда нужно вывести результат (см. скриншот).
5. После этого нажмите кнопку ОК. Теперь строки, дата в которых соответствует сегодняшней, будут немедленно вставлены на новый лист (см. скриншот).
Копирование строк и вставка на другой лист, если дата позже сегодняшней
Чтобы скопировать и вставить строки, дата в которых больше или равна сегодняшней (например, дата наступает через 5 дней или позже), перенесите такие строки на другой лист.
Следующий код VBA может помочь вам в этом:
1. Удерживая клавиши ALT + F11, откройте окно Microsoft Visual Basic для приложений.
2. Нажмите Вставить>Модульи вставьте следующий код в окно модуля.
Код VBA: копирование и вставка строк, если дата позже сегодняшней:
Sub CopyRow()
'Updateby Extentoffice
Dim xRgS As Range, xRgD As Range, xCell As Range
Dim I As Long, xCol As Long, J As Long
Dim xVal As Variant
On Error Resume Next
Set xRgS = Application.InputBox("Please select the date column:", "KuTools For Excel", Selection.Address, , , , , 8)
If xRgS Is Nothing Then Exit Sub
Set xRgD = Application.InputBox("Please select a destination cell:", "KuTools For Excel", , , , , , 8)
If xRgD Is Nothing Then Exit Sub
xCol = xRgS.Rows.Count
Set xRgS = xRgS(1)
Application.CutCopyMode = False
J = 0
For I = 1 To xCol
Set xCell = xRgS.Offset(I - 1, 0)
xVal = xCell.Value
If TypeName(xVal) = "Date" And (xVal <> "") And (xVal >= Date And (xVal < Date + 5)) Then
xCell.EntireRow.Copy xRgD.Offset(J, 0)
J = J + 1
End If
Next
Application.CutCopyMode = True
End Sub
Примечание: в приведённом выше коде вы можете изменить условие — например, указать «меньше сегодняшней даты» или задать нужное количество дней — в строке кода If TypeName(xVal) = «Date» And (xVal "") And (xVal >= Date And (xVal < Date + 5)) Then.
3. Затем нажмите клавишу F5, чтобы запустить этот код. В появившемся диалоговом окне выберите столбец с данными, который вы хотите использовать (см. скриншот).
4. Затем нажмите кнопку ОК. В следующем диалоговом окне выберите ячейку на другом листе, куда следует вывести результат (см. скриншот).
5. Нажмите кнопку ОК. Теперь строки, дата в которых равна сегодняшней или более чем на 5 дней от неё, скопированы и вставлены на новый лист, как показано на следующем скриншоте:
Лучшие инструменты повышения продуктивности в Office
Раскройте весь потенциал Excel с помощью Kutools для Excel и ощутите эффективность как никогда раньше.Kutools для Excel предлагает более 300 расширенных функций для повышения продуктивности и Экономия времени.Нажмите здесь, чтобы получить нужную Вам функцию…
Office Tab добавляет в Office вкладки и значительно упрощает Вашу работу
- Включите редактирование и чтение во вкладках в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
- Открывайте и создавайте несколько документов во вкладках одного окна — вместо того чтобы использовать отдельные окна.
- Повышает вашу продуктивность на 50 % и экономит сотни кликов мышью каждый день!
Все надстройки Kutools — один установщик
Kutools for Office — набор надстроек для Excel, Word, Outlook и PowerPoint, а также Office Tab Pro, идеально подходящий командам, работающим с разными приложениями Office.
- Единый комплект— надстройки для Excel, Word, Outlook и PowerPoint + Office Tab Pro
- Один установщик, одна лицензия— настройка занимает считанные минуты (готово для MSI)
- Лучше работать вместе— оптимизированная продуктивность во всех приложениях Office
- 30-дневная полнофункциональная пробная версия— без регистрации и кредитной карты
- Лучшее соотношение цены и качества— экономия по сравнению с покупкой отдельных надстроек