Hvordan kopieres rækker og indsættes på et andet ark baseret på dato i Excel?
Antag, jeg har en række data, nu vil jeg kopiere hele rækkerne baseret på en bestemt dato og derefter indsætte dem i et andet ark. Har du gode ideer til at håndtere dette job i Excel?
Kopier rækker og indsæt til et andet ark baseret på dagens dato
Kopier rækker og indsæt til et andet ark, hvis datoen er større end i dag
Kopier rækker og indsæt til et andet ark baseret på dagens dato
Hvis du har brug for at kopiere rækkerne, hvis datoen er i dag, skal du anvende følgende VBA-kode:
1. Hold nede ALT + F11 nøgler til at åbne Microsoft Visual Basic til applikationer vindue.
2. Klik indsatte > Moduler, og indsæt følgende kode i modulvinduet.
VBA-kode: Kopier og indsæt rækker baseret på dagens dato:
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. Når du har indsat ovenstående kode, skal du trykke på F5 nøgle til at køre denne kode, og der vises et promptfelt for at minde dig om at vælge den datakolonne, som du vil kopiere rækker baseret på, se skærmbillede:
4. Klik derefter på OK knap, i en anden promptboks skal du vælge en celle i et andet ark, hvor du vil sende resultatet, se skærmbillede:
5. Og klik derefter på OK knap, nu indsættes de rækker, som datoen er i dag, med det samme i det nye ark, se skærmbillede:
Kopier rækker og indsæt til et andet ark, hvis datoen er større end i dag
For at kopiere og indsætte de rækker, hvis dato er større end eller lig med i dag, hvis f.eks. Datoen er lig med eller større end 5 dage siden i dag, skal du kopiere og indsætte rækkerne til et andet ark.
Følgende VBA-kode kan gøre dig en tjeneste:
1. Hold nede ALT + F11 nøgler til at åbne Microsoft Visual Basic til applikationer vindue.
2. Klik indsatte > Moduler, og indsæt følgende kode i modulvinduet.
VBA-kode: Kopier og indsæt rækker, hvis datoen er større end i dag:
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
Bemærk: I ovenstående kode kan du ændre kriterierne, f.eks. Mindre end i dag eller antallet af dage, som du har brug for i Hvis TypeName (xVal) = "Date" And (xVal <> "") And (xVal> = Date And (xVal <Date + 5)) Then script kode.
3. Tryk derefter på F5 nøgle til at køre denne kode, i promptboksen skal du vælge den datakolonne, du vil bruge, se skærmbillede:
4. Klik derefter på OK knap, i en anden promptboks skal du vælge en celle i et andet ark, hvor du vil sende resultatet, se skærmbillede:
5. Klik på OK knap, nu er de rækker, hvor datoen er lig med eller større end 5 dage siden i dag, blevet kopieret og indsat i det nye ark som følgende skærmbillede vist:
Bedste kontorproduktivitetsværktøjer
Overlad dine Excel-færdigheder med Kutools til Excel, og oplev effektivitet som aldrig før. Kutools til Excel tilbyder over 300 avancerede funktioner for at øge produktiviteten og spare tid. Klik her for at få den funktion, du har mest brug for...
Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere
- Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
- Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
- Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!
