Как да копирате редове и да ги поставите в друг лист въз основа на дата в 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, След това кликнете OK бутон, в друго поле за подкана изберете клетка в друг лист, където искате да изведете резултата, вижте екранна снимка:
5, И после щракнете върху OK бутон, сега редовете, чиято дата е днес, се поставят в новия лист наведнъж, вижте екранната снимка:
Копирайте редове и ги поставете в друг лист, ако датата е по-голяма от днешната
За да копирате и поставите редовете, чиято дата е по-голяма или равна на днешната, например, ако датата е равна или по-голяма от 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
Забележка: В горния код можете да промените критериите, като например по-малко от днес или броя дни, колкото ви е необходимо в Ако TypeName(xVal) = "Дата" И (xVal <> "") И (xVal >= Дата И (xVal < Дата + 5)) Тогава код на скрипта.
3. След това натиснете F5 за да стартирате този код, в полето за подкана, моля, изберете колоната с данни, която искате да използвате, вижте екранната снимка:
4, След това кликнете OK бутон, в друго поле за подкана изберете клетка в друг лист, където искате да изведете резултата, вижте екранна снимка:
5, Кликнете на OK бутон, сега редовете, чиято дата е равна или по-голяма от 5 дни от днес, са копирани и поставени в новия лист, както е показано на следната екранна снимка:
Най-добрите инструменти за продуктивност в офиса
Усъвършенствайте уменията си за Excel с Kutools за Excel и изпитайте ефективност, както никога досега. Kutools за Excel предлага над 300 разширени функции за повишаване на производителността и спестяване на време. Щракнете тук, за да получите функцията, от която се нуждаете най-много...
Раздел Office Внася интерфейс с раздели в Office и прави работата ви много по-лесна
- Разрешете редактиране и четене с раздели в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
- Отваряйте и създавайте множество документи в нови раздели на един и същ прозорец, а не в нови прозорци.
- Увеличава вашата производителност с 50% и намалява стотици кликвания на мишката за вас всеки ден!
