Jak skopiować wiersze i wkleić do innego arkusza na podstawie daty w programie Excel?
Przypuśćmy, że mam zakres danych, teraz chcę skopiować całe wiersze na podstawie określonej daty, a następnie wkleić je do innego arkusza. Czy masz jakieś dobre pomysły na wykonanie tej pracy w programie Excel?
Skopiuj wiersze i wklej je do innego arkusza na podstawie dzisiejszej daty
Skopiuj wiersze i wklej je do innego arkusza, jeśli data jest większa niż dzisiaj
Skopiuj wiersze i wklej je do innego arkusza na podstawie dzisiejszej daty
Jeśli chcesz skopiować wiersze, jeśli data jest dzisiaj, zastosuj następujący kod VBA:
1. Przytrzymaj ALT + F11 klawisze, aby otworzyć Microsoft Visual Basic for Applications okno.
2. Kliknij wstawka > Modułi wklej następujący kod w oknie modułu.
Kod VBA: Skopiuj i wklej wiersze na podstawie dzisiejszej daty:
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. Po wklejeniu powyższego kodu naciśnij F5 klucz do uruchomienia tego kodu, a pojawi się okienko zachęty przypominające o wybraniu kolumny z datą, na podstawie której chcesz skopiować wiersze, patrz zrzut ekranu:
4. Następnie kliknij OK przycisk, w innym polu zachęty wybierz komórkę w innym arkuszu, w którym chcesz wyprowadzić wynik, zobacz zrzut ekranu:
5. A następnie kliknij OK przycisk, teraz wiersze z dzisiejszą datą są wklejane od razu do nowego arkusza, patrz zrzut ekranu:
Skopiuj wiersze i wklej je do innego arkusza, jeśli data jest większa niż dzisiaj
Aby skopiować i wkleić wiersze, których data jest większa lub równa dzisiejszej, na przykład, jeśli data jest równa lub większa niż 5 dni od dzisiaj, skopiuj i wklej wiersze do innego arkusza.
Poniższy kod VBA może wyświadczyć ci przysługę:
1. Przytrzymaj ALT + F11 klawisze, aby otworzyć Microsoft Visual Basic for Applications okno.
2. Kliknij wstawka > Modułi wklej następujący kod w oknie modułu.
Kod VBA: Skopiuj i wklej wiersze, jeśli data jest większa niż dzisiaj:
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
Note: W powyższym kodzie możesz zmienić kryteria, takie jak mniej niż dzisiaj lub liczba dni, ile potrzebujesz w Jeśli TypeName (xVal) = "Date" And (xVal <> "") And (xVal> = Date And (xVal <Date + 5)) Then kod skryptu.
3. Następnie naciśnij F5 klucz do uruchomienia tego kodu, w polu zachęty wybierz kolumnę danych, której chcesz użyć, zobacz zrzut ekranu:
4. Następnie kliknij OK przycisk, w innym polu zachęty wybierz komórkę w innym arkuszu, w którym chcesz wyprowadzić wynik, zobacz zrzut ekranu:
5, Kliknij OK przycisk, teraz wiersze, których data jest równa lub większa niż 5 dni od dzisiaj, zostały skopiowane i wklejone do nowego arkusza, jak pokazano na poniższym zrzucie ekranu:
Najlepsze narzędzia biurowe
Zwiększ swoje umiejętności Excela dzięki Kutools for Excel i doświadcz wydajności jak nigdy dotąd. Kutools dla programu Excel oferuje ponad 300 zaawansowanych funkcji zwiększających produktywność i oszczędzających czas. Kliknij tutaj, aby uzyskać funkcję, której najbardziej potrzebujesz...
Karta Office wprowadza interfejs z zakładkami do pakietu Office i znacznie ułatwia pracę
- Włącz edycję i czytanie na kartach w programach Word, Excel, PowerPoint, Publisher, Access, Visio i Project.
- Otwieraj i twórz wiele dokumentów w nowych kartach tego samego okna, a nie w nowych oknach.
- Zwiększa produktywność o 50% i redukuje setki kliknięć myszką każdego dnia!
