Ինչպե՞ս պատճենել տողերը և տեղադրել 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 Tab- ը Tabbed ինտերֆեյսը բերում է Office, և ձեր աշխատանքը շատ ավելի դյուրին դարձրեք
- Միացնել ներդիրներով խմբագրումը և ընթերցումը Word, Excel, PowerPoint- ով, Հրատարակիչ, Access, Visio և Project:
- Բացեք և ստեղծեք բազմաթիվ փաստաթղթեր նույն պատուհանի նոր ներդիրներում, այլ ոչ թե նոր պատուհաններում:
- Բարձրացնում է ձեր արտադրողականությունը 50%-ով և նվազեցնում մկնիկի հարյուրավոր սեղմումները ձեզ համար ամեն օր:
