Перейти до основного матеріалу

Як скопіювати рядки та вставити на інший аркуш на основі дати в Excel? 

Припустимо, у мене є ряд даних, тепер я хочу скопіювати цілі рядки на основі певної дати, а потім вставити їх на інший аркуш. Чи є у вас якісь ідеї, як впоратися з цією роботою в Excel?

Скопіюйте рядки та вставте їх на інший аркуш, виходячи із сьогоднішньої дати

Скопіюйте рядки та вставте їх на інший аркуш, якщо дата перевищує сьогоднішню


Скопіюйте рядки та вставте їх на інший аркуш, виходячи із сьогоднішньої дати

Якщо вам потрібно скопіювати рядки, якщо сьогодні дата, застосуйте такий код VBA:

1. Утримуйте клавішу ALT + F11 ключі, щоб відкрити Microsoft Visual Basic для додатків вікна.

2. Клацання Insert > Модуліта вставте наступний код у вікно модуля.

Код 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. Потім натисніть OK , в іншому вікні запиту виберіть клітинку на іншому аркуші, куди ви хочете вивести результат, див. знімок екрана:

5. А потім клацніть OK Кнопка, тепер рядки, дата яких сьогодні, вставляються в новий аркуш одразу, див. знімок екрана:


Скопіюйте рядки та вставте їх на інший аркуш, якщо дата перевищує сьогоднішню

Щоб скопіювати та вставити рядки, дата яких більша або дорівнює сьогоднішній, наприклад, якщо дата дорівнює або перевищує 5 днів від сьогодні, скопіюйте та вставте рядки на інший аркуш.

Наступний код VBA може зробити вам послугу:

1. Утримуйте клавішу ALT + F11 ключі, щоб відкрити Microsoft Visual Basic для додатків вікна.

2. Клацання Insert > Модуліта вставте наступний код у вікно модуля.

Код 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

примітки: У наведеному вище коді ви можете змінити критерії, наприклад менше, ніж сьогодні, або кількість днів, скільки вам потрібно в Якщо TypeName (xVal) = "Date" And (xVal <> "") And (xVal> = Date And (xVal <Date + 5)) Тоді код сценарію.

3. Потім натисніть F5 клавішу для запуску цього коду, у вікні підказки виберіть стовпець даних, який потрібно використовувати, див. знімок екрана:

4. Потім натисніть OK , в іншому вікні запиту виберіть клітинку на іншому аркуші, куди ви хочете вивести результат, див. знімок екрана:

5. Натисніть OK Тепер рядки, дата яких дорівнює або перевищує 5 днів з сьогоднішнього дня, були скопійовані та вставлені на новий аркуш, як показано на наступному знімку екрана:

Найкращі інструменти продуктивності офісу

Популярні функції: Знайдіть, виділіть або визначте дублікати   |  Видалити порожні рядки   |  Об’єднайте стовпці або клітинки без втрати даних   |   Раунд без Формули ...
Супер пошук: VLookup за кількома критеріями    Багатозначний VLookup  |   VLookup на кількох аркушах   |   Нечіткий пошук ....
Розширений розкривний список: Швидке створення випадаючого списку   |  Залежний спадний список   |  Виберіть розкривний список, що вибирається ....
Менеджер колонок: Додайте конкретну кількість стовпців  |  Перемістити стовпці  |  Перемкнути статус видимості прихованих стовпців  |  Порівняйте діапазони та стовпці ...
Особливості: Фокус сітки   |  Перегляд дизайну   |   Велика панель формул    Диспетчер робочих книг і аркушів   |  Бібліотека ресурсів (автотекст)   |  Вибір дати   |  Об’єднайте робочі аркуші   |  Шифрування/розшифрування клітинок    Надсилайте листи за списком   |  Супер фільтр   |   Спеціальний фільтр (фільтр жирний/курсив/закреслений...) ...
Топ-15 наборів інструментів12 текст Tools (додати текст, Видалити символи, ...)   |   50 + Графік типи (діаграма Ганта, ...)   |   40+ Практичний Формули (Розрахуйте вік на основі дня народження, ...)   |   19 вставка Tools (Вставте QR-код, Вставити зображення зі шляху, ...)   |   12 Перетворення Tools (Числа до слів, Валютна конверсія, ...)   |   7 Злиття та розділення Tools (Розширені комбіновані ряди, Розділені клітини, ...)   |   ... і більше

Покращуйте свої навички Excel за допомогою Kutools для Excel і відчуйте ефективність, як ніколи раніше. Kutools для Excel пропонує понад 300 додаткових функцій для підвищення продуктивності та економії часу.  Натисніть тут, щоб отримати функцію, яка вам найбільше потрібна...

вкладка kte 201905


Вкладка Office Передає інтерфейс із вкладками в Office і значно полегшує вашу роботу

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
Comments (3)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Is it possible to do this for an entire workbook if the date is always in the same column on each? If so, what would the VBA code be, or which bit would I change?
This comment was minimized by the moderator on the site
Did you get a reply on this?
This comment was minimized by the moderator on the site
Same here. Would really like an answer!
THANKS ALOT ALREADY EXTENDOFFICe :D
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations