Як скопіювати рядки та вставити на інший аркуш на основі дати в 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 днів з сьогоднішнього дня, були скопійовані та вставлені на новий аркуш, як показано на наступному знімку екрана:
Найкращі інструменти продуктивності офісу
Покращуйте свої навички Excel за допомогою Kutools для Excel і відчуйте ефективність, як ніколи раніше. Kutools для Excel пропонує понад 300 додаткових функцій для підвищення продуктивності та економії часу. Натисніть тут, щоб отримати функцію, яка вам найбільше потрібна...
Вкладка Office Передає інтерфейс із вкладками в Office і значно полегшує вашу роботу
- Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
- Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
- Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
