Sut i gopïo rhesi a'u pastio i ddalen arall yn seiliedig ar ddyddiad yn Excel?
Gan dybio, mae gen i ystod o ddata, nawr, rydw i eisiau copïo'r rhesi cyfan yn seiliedig ar ddyddiad penodol ac yna eu pastio i mewn i ddalen arall. Oes gennych chi unrhyw syniadau da i ddelio â'r swydd hon yn Excel?
Copïwch resi a'u pastio i ddalen arall yn seiliedig ar y dyddiad heddiw
Copïwch resi a'u pastio i ddalen arall os yw'r dyddiad yn fwy na heddiw
Copïwch resi a'u pastio i ddalen arall yn seiliedig ar y dyddiad heddiw
Os oes angen i chi gopïo'r rhesi os yw'r dyddiad heddiw, defnyddiwch y cod VBA canlynol:
1. Daliwch i lawr y ALT + F11 allweddi i agor y Microsoft Visual Basic ar gyfer Ceisiadau ffenestr.
2. Cliciwch Mewnosod > Modiwlau, a gludwch y cod canlynol yn y Ffenestr Modiwl.
Cod VBA: Copïo a gludo rhesi yn seiliedig ar ddyddiad heddiw:
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. Ar ôl pasio'r cod uchod, pwyswch F5 allwedd i redeg y cod hwn, a bydd blwch prydlon yn popio allan i'ch atgoffa i ddewis y golofn ddyddiad rydych chi am gopïo rhesi yn seiliedig arni, gweler y screenshot:
4. Yna cliciwch OK botwm, mewn blwch prydlon arall, dewiswch gell mewn dalen arall lle rydych chi am allbwn y canlyniad, gweler y screenshot:
5. Ac yna cliciwch OK botwm, nawr, mae'r rhesi sy'n dyddio heddiw yn cael eu pastio i'r ddalen newydd ar unwaith, gweler y screenshot:
Copïwch resi a'u pastio i ddalen arall os yw'r dyddiad yn fwy na heddiw
I gopïo a gludo'r rhesi sy'n dyddio sy'n fwy na neu'n hafal i heddiw, er enghraifft, os yw'r dyddiad yn hafal neu'n fwy na 5 diwrnod ers heddiw, yna copïwch a gludwch y rhesi i ddalen arall.
Efallai y bydd y cod VBA canlynol yn ffafrio chi:
1. Daliwch i lawr y ALT + F11 allweddi i agor y Microsoft Visual Basic ar gyfer Ceisiadau ffenestr.
2. Cliciwch Mewnosod > Modiwlau, a gludwch y cod canlynol yn y Ffenestr Modiwl.
Cod VBA: Copïwch a gludwch resi os yw'r dyddiad yn fwy na heddiw:
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
Nodyn: Yn y cod uchod, gallwch newid y meini prawf, fel llai na heddiw neu nifer y diwrnodau sydd eu hangen arnoch yn y If TypeName (xVal) = "Dyddiad" A (xVal <> "") A (xVal> = Dyddiad A (xVal <Dyddiad + 5)) Yna cod sgript.
3. Yna pwyswch F5 allwedd i redeg y cod hwn, yn y blwch prydlon, dewiswch y golofn ddata rydych chi am ei defnyddio, gweler y screenshot:
4. Yna cliciwch OK botwm, mewn blwch prydlon arall, dewiswch gell mewn dalen arall lle rydych chi am allbwn y canlyniad, gweler y screenshot:
5. Cliciwch y OK botwm, nawr, mae'r rhesi y mae'r dyddiad yn hafal neu'n fwy na 5 diwrnod ers heddiw wedi cael eu copïo a'u pastio i'r ddalen newydd fel y dangosir y screenshot canlynol:
Offer Cynhyrchiant Swyddfa Gorau
Supercharge Eich Sgiliau Excel gyda Kutools ar gyfer Excel, a Phrofiad Effeithlonrwydd Fel Erioed Erioed. Kutools ar gyfer Excel Yn Cynnig Dros 300 o Nodweddion Uwch i Hybu Cynhyrchiant ac Arbed Amser. Cliciwch Yma i Gael Y Nodwedd Sydd Ei Angen Y Mwyaf...
Mae Office Tab yn dod â rhyngwyneb Tabbed i Office, ac yn Gwneud Eich Gwaith yn Haws o lawer
- Galluogi golygu a darllen tabbed yn Word, Excel, PowerPoint, Cyhoeddwr, Mynediad, Visio a Phrosiect.
- Agor a chreu dogfennau lluosog mewn tabiau newydd o'r un ffenestr, yn hytrach nag mewn ffenestri newydd.
- Yn cynyddu eich cynhyrchiant 50%, ac yn lleihau cannoedd o gliciau llygoden i chi bob dydd!
