Note: The other languages of the website are Google-translated. Back to English

Ինչպե՞ս ամբողջ շարքը տեղափոխել մեկ այլ թերթ `հիմնված բջջային արժեքի վրա Excel- ում:

Ամբողջ շարքը բջջային արժեքի հիման վրա մեկ այլ թերթ տեղափոխելու համար այս հոդվածը կօգնի ձեզ:

VBA կոդով բջջային արժեքի հիման վրա ամբողջ շարքը տեղափոխեք մեկ այլ թերթ
Excel- ի համար Kutools- ի հետ ամբողջ շարքը տեղափոխեք մեկ այլ թերթ `հիմնված բջջային արժեքի վրա


VBA կոդով բջջային արժեքի հիման վրա ամբողջ շարքը տեղափոխեք մեկ այլ թերթ

Ինչպես ցույց է տրված սքրինշոթից ներքևում, անհրաժեշտ է ամբողջ տողը Sheet1- ից Sheet2 տեղափոխել, եթե C սյունակում գոյություն ունի «Կատարված» որոշակի բառը: Կարող եք փորձել հետևյալ VBA կոդը:

1. Մամուլ ալտ+ F11 ստեղները միաժամանակ բացելու համար Microsoft Visual Basic հավելվածների համար պատուհան.

2. Microsoft Visual Basic հավելվածների համար պատուհանում կտտացրեք Տեղադրել > Մոդուլներ, Դրանից հետո պատճենեք և տեղադրեք ներքևի VBA կոդը պատուհանում:

VBA code 1: Move entire row to another sheet based on cell value

Sub Cheezy()
'Updated by Kutools for Excel 2017/8/28
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Done" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

ՆշումԿոդում, Sheet1 աշխատանքային թերթը պարունակում է այն տողը, որը ցանկանում եք տեղափոխել: Եվ Sheet2 նպատակակետի աշխատանքային թերթն է, որտեղ դուք կգտնեք տողը: «C: C»Սյունակը պարունակում է որոշակի արժեք, իսկ«Կատարված”Այն որոշակի արժեքն է, որի հիման վրա դուք տողը կտեղափոխեք: Խնդրում ենք փոխել դրանք ՝ ելնելով ձեր կարիքներից:

3. Սեղմեք F5 Կոդը գործարկելու բանալին, ապա Sheet1- ի չափանիշներին համապատասխանող շարքը անմիջապես կտեղափոխվի Sheet2:

ՆշումՎերոհիշյալ VBA կոդը կջնջի տողերը բնօրինակ տվյալներից ՝ նշված աշխատանքային թերթ անցնելուց հետո: Եթե ​​ցանկանում եք պատճենել տողերը ՝ հիմնվելով միայն բջջային արժեքի վրա, դրանք ջնջելու փոխարեն: Խնդրում ենք կիրառել ստորև նշված VBA կոդը 2:

VBA code 2: Copy entire row to another sheet based on cell value

Sub MoveRowBasedOnCellValue()
'Updated by Extendoffice 2017/11/10
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Excel- ի համար Kutools- ի հետ ամբողջ շարքը տեղափոխեք մեկ այլ թերթ `հիմնված բջջային արժեքի վրա

Եթե ​​դուք նորեկ եք VBA կոդում: Այստեղ ես ներկայացնում եմ Ընտրեք հատուկ բջիջներ օգտակարությունը Excel- ի համար նախատեսված գործիքներ, Այս օգտակար ծառայության միջոցով դուք կարող եք հեշտությամբ ընտրել բոլոր տողերը `հիմնված որոշակի բջջային արժեքի կամ բջջի տարբեր արժեքների վրա` աշխատանքային թերթում, և ընտրված տողերը պատճենեք նպատակակետի աշխատաթերթին, որքան ձեզ հարկավոր է: Խնդրում եմ, արեք հետևյալ կերպ.

Նախքան դիմելը Excel- ի համար նախատեսված գործիքներ, խնդրում եմ նախ ներբեռնեք և տեղադրեք այն.

1. Ընտրեք սյունակների ցուցակը պարունակում է այն բջիջի արժեքը, որի հիման վրա դուք կտեղափոխեք տողեր, ապա կտտացրեք Կուտոլս > ընտրել > Ընտրեք հատուկ բջիջներ, Տեսեք,

2. Բացման մեջ Ընտրեք հատուկ բջիջներ երկխոսության վանդակում, ընտրեք Ամբողջ շարքը է Ընտրության տեսակը բաժին ընտրեք հավասար է Հատուկ տեսակ բացվող ցուցակը, տեքստի վանդակում մուտքագրեք վանդակի արժեքը և այնուհետև կտտացրեք այն OK կոճակը:

Ուրիշ Ընտրեք հատուկ բջիջներ երկխոսության պատուհանը բացվում է ՝ ցույց տալու համար ընտրված շարքերի քանակը, և մինչ այդ, բոլոր տողերը պարունակում են նշված արժեքը ընտրված սյունակում, ընտրված են: Տեսեք,

3. Սեղմեք Ctrl + C ստեղները ընտրված տողերը պատճենելու և դրանք տեղադրելու համար անհրաժեշտ նպատակակետի աշխատաթերթում:

ՆշումԵթե ​​ցանկանում եք տողերը տեղափոխել մեկ այլ աշխատանքային թերթ `հիմնված բջջի երկու տարբեր արժեքների վրա: Օրինակ, տողերը տեղափոխել `հիմնվելով բջջային արժեքների վրա` կամ «Կատարված» կամ «Մշակում», կարող եք միացնել այն Or վիճակը Ընտրեք հատուկ բջիջներ երկխոսության տուփ, ինչպես ցույց է տրված ստորև նշված նկարը.

  Եթե ​​ցանկանում եք ունենալ անվճար փորձաշրջան (30-օր) այս կոմունալ, խնդրում ենք կտտացնել այն ներբեռնելու համար, և այնուհետև անցեք գործողությունը կիրառելու վերը նշված քայլերին համապատասխան:


Առնչվող հոդվածներ:


Գրասենյակի արտադրողականության լավագույն գործիքները

Excel-ի համար Kutools-ը լուծում է ձեր խնդիրների մեծ մասը և բարձրացնում ձեր արտադրողականությունը 80%-ով

  • Վերաօգտագործել: Արագ տեղադրեք բարդ բանաձևեր, գծապատկերներ և այն ամենը, ինչ դուք նախկինում օգտագործել եք. Ryածկագրել բջիջները գաղտնաբառով; Ստեղծեք փոստային ցուցակ և նամակներ ուղարկել ...
  • Super Formula Bar (հեշտությամբ խմբագրեք տեքստի և բանաձևի բազմաթիվ տողեր); Ընթերցանության դասավորությունը (հեշտությամբ կարդալ և խմբագրել մեծ թվով բջիջներ); Տեղադրել ֆիլտրացված տիրույթում...
  • Միաձուլել բջիջները / տողերը / սյունակները առանց տվյալների կորստի. Պառակտված բջիջների պարունակությունը; Միավորել կրկնօրինակ տողերը / սյունակները... Կանխել կրկնօրինակ բջիջները; Համեմատեք միջակայքերը...
  • Ընտրեք Կրկնօրինակ կամ Եզակի Շարքեր; Ընտրեք դատարկ շարքեր (բոլոր բջիջները դատարկ են); Super Find և Fuzzy Find շատ աշխատանքային գրքույկներում; Պատահական ընտրություն ...
  • Actշգրիտ պատճեն Բազմաթիվ բջիջներ ՝ առանց բանաձևի հղումը փոխելու; Ավտոմատ ստեղծեք հղումներ դեպի մի քանի թերթեր; Տեղադրեք փամփուշտներ, Տուփեր և ավելին ...
  • Քաղվածք տեքստ, Տեքստ ավելացնել, հեռացնել ըստ դիրքի, Հեռացնել տարածությունը; Ստեղծել և տպել էջային ենթագոտիներ; Փոխարկել բջիջների բովանդակության և մեկնաբանությունների միջև...
  • Սուպեր զտիչ (պահպանել և կիրառել ֆիլտրի սխեմաները այլ թերթերի վրա); Ընդլայնված տեսակավորում ըստ ամիս / շաբաթ / օր, հաճախականություն և ավելին; Հատուկ զտիչ համարձակ, շեղատառով ...
  • Միավորել աշխատանքային տետրերը և աշխատանքային թերթերը; Միավորել աղյուսակները ՝ հիմնված հիմնական սյունակների վրա; Տվյալները բաժանեք մի քանի թերթերի; Խմբաքանակի փոխակերպում xls, xlsx և PDF...
  • Ավելի քան 300 հզոր հատկություններ. Աջակցում է Office / Excel 2007-2021 և 365: Աջակցում է բոլոր լեզուներին: Հեշտ տեղակայում ձեր ձեռնարկությունում կամ կազմակերպությունում: Ամբողջական հնարավորություններ 30-օրյա անվճար փորձարկում: 60-օրյա գումարի վերադարձի երաշխիք:
kte էջանիշը 201905

Office Tab- ը Tabbed ինտերֆեյսը բերում է Office, և ձեր աշխատանքը շատ ավելի դյուրին դարձրեք

  • Միացնել ներդիրներով խմբագրումը և ընթերցումը Word, Excel, PowerPoint- ով, Հրատարակիչ, Access, Visio և Project:
  • Բացեք և ստեղծեք բազմաթիվ փաստաթղթեր նույն պատուհանի նոր ներդիրներում, այլ ոչ թե նոր պատուհաններում:
  • Բարձրացնում է ձեր արտադրողականությունը 50%-ով և նվազեցնում մկնիկի հարյուրավոր սեղմումները ձեզ համար ամեն օր:
officetab ներքևում
Տեսակավորել մեկնաբանությունները ըստ
մեկնաբանություններ (299)
Դեռևս գնահատականներ չկան: Եղիր առաջինը, ով կգնահատի:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, ես գտա այս հատուկ ուղեցույցը, որն իսկապես օգտակար է իմ տեսած մյուսների նկատմամբ: Շնորհակալություն! Իմ խնդիրն այն է, որ եթե ես փոխեմ իմ ցանկալի արժեքը «Փակ», ես պետք է գործարկեմ F5 տողը տեղափոխելու համար: Ես կցանկանայի, որ այն ինքնաբերաբար շարժվի: Ես նոր եմ Excel-ում, ուստի ձեր օգնությունը մեծապես գնահատելի է: Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Worksheets("ECR Incident Tracker").UsedRange.Rows.Count J = Worksheets("Resolved Issues").UsedRange.Rows. Count If J = 1 Ապա Եթե Application.WorksheetFunction.CountA(Worksheets("Resolved Issues").UsedRange) = 0 Այնուհետեւ J = 0 End If Set xRg = Worksheets("ECR Incident Tracker").Range("B1:B" & I) Սխալի դեպքում Resume Next Application.ScreenUpdating = False Յուրաքանչյուր xCell-ի համար xRg Եթե CStr(xCell.Value) = "Closed" Այնուհետեւ xCell.EntireRow.Copy Destination:=Worksheets("Resolved Issues").Range("A"): & J + 1) xCell.EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև ձեզ, ես փորձում եմ ավտոմատացնել բջիջների տեղափոխումը առանց մոդուլը բացելու և նաև F5 սեղմելու: Դուք երբևէ լուծել եք այս հարցը: Նախապես շնորհակալություն!
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Crystal-ը տեղեկատվություն է տրամադրել այն մասին, թե ինչպես դա անել այսօր. դիտեք այս թեմայի առաջին էջը՝ տեսնելու նրա պատասխանը: Այն ավտոմատ կերպով տեղափոխում է այսօրվա ամսաթվով տողը սյունակում (Իմ դեպքում L) մեկ այլ աշխատաթերթ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ես գործարկում եմ այս կոդը և փորձում եմ տեղափոխել տող՝ հիմնվելով I սյունակում հայտնվող այսօրվա ամսաթվի վրա. ես փոխել եմ Range("B1:B" & I)՝ կարդալու Range(I1:I" & I): Ես փոխել եմ " Կատարված է» ձեր օրինակում մինչև ամսաթիվ: Այնուամենայնիվ, երբ այսօրվա ամսաթիվը հայտնվում է տողում որևէ տեղ, ոչ միայն I սյունակում, ինչպես պահանջվում է, տողը տեղափոխվում է այլընտրանքային աշխատաթերթ: Ցանկացած պատկերացում, թե ինչու է դա տեղի ունենում, և ինչպես կարող եմ տողը տեղափոխել: միայն այն դեպքում, երբ այսօրվա ամսաթիվը I սյունակում է, անկախ նրանից, թե այսօրվա ամսաթիվը այլ սյունակներում է հայտնվում:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Եթե ​​ես ուզենայի ունենալ շատ արժեքներ և շատ թերթեր՝ տողը տեղափոխելու համար, ես պետք է նորից գրեի ամբողջ կոդը այդ բջիջի համար այլ արժեքով: Այսինքն, եթե ես NA-ն դնեմ մեկ բջիջում, այն անցնում է Na թերթիկ, իսկ եթե դնեմ W#, այն կգնա սխալ թվային թերթիկ և այլն:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
բարև, սա շատ օգտակար էր: Արդյո՞ք դա անելու միջոց կա առանց տվյալների շարքը երկրորդ թերթիկ տեղափոխելու, այլ այն պատճենելու: Այսպիսով, տվյալները կմնա՞ն երկու թերթիկների վրա:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն, կոդը շատ օգտակար էր, բայց ամբողջ շարքը պատճենելու փոխարեն ես պահանջում եմ, որ տողի որոշակի ընտրություն տեղափոխվի հաջորդ թերթ: ինչպես կարող եմ սահմանել միջակայք ամբողջ տողի փոխարեն Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Worksheets("Sheet1").UsedRange.Rows.Count J = Worksheets(" Sheet2").UsedRange.Rows.Count If J = 1 Ապա Եթե Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Այնուհետեւ J = 0 End Եթե Սահմանել xRg = Worksheets("Sheet1").Range( «C1:C» և I) Սխալի դեպքում Resume Next Application.ScreenUpdating = False Յուրաքանչյուր xCell-ի համար xRg-ում Եթե CStr(xCell.Value) = «Կատարված է», Ապա xCell:Ամբողջ տողՊատճենել նպատակակետը:=Աշխատանքային թերթիկներ("Sheet2").Range("A" & J + 1) J = J + 1 End If Next Application.ScreenUpdating = True End Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
ո՞րը կլինի կոդը, եթե ես ուզում եմ տողերը (հատուկ բջիջները) պատճենել մեկ այլ թերթում՝ կոնկրետ բջիջներում: ԲԱՅՑ նաև արժեքի վրա հիմնված Օրինակ. գունավոր արտադրանքի պատկերների տող սպիտակ բլենդեր 2 whiteblender2 սև հյութեղացուցիչ 3 blackjuicer3 կարմիր հեռուստացույց 1 redtv1 կանաչ երկաթ 4 greeniron4 Ես կցանկանայի, որ տողը պատճենվի մեկ այլ թերթիկի վրա, բայց պատկերների սյունակի համարը ցույց է տալիս, թե քանի անգամ այն ​​պետք է պատճենվի (այսպես, այս դեպքում, բլենդերի տողը պետք է պատճենել 2 շարքով
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն, շատ լավ կոդ է, շատ լավ է աշխատում: Ինչպե՞ս փոխել այս կոդը՝ տողերը մի աղյուսակից մյուս աղյուսակ տեղափոխելու համար, մեկ թերթի փոխարեն մեկ այլ թերթ: Շատ շնորհակալություն !
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, ես փորձում եմ օգտագործել կոդը, բայց Dim xCell As Range-ում շարահյուսական սխալ եմ ստանում: Կարող եք օգնել խնդրում եմ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Worksheets("Sheet1").UsedRange.Rows.Count J = Worksheets("Sheet2").UsedRange.Rows.Count If J. = 1 Հետո If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Այնուհետեւ J = 0 Վերջ Եթե Սահմանել xRg = Worksheets("Sheet1").Range("C1:C" & I) Սխալի դեպքում Resume Հաջորդ Application.ScreenUpdating = Սխալ յուրաքանչյուր xCell-ի համար xRg-ում Եթե CStr(xCell.Value) = «Կատարված է», Ապա xCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1) xCell: EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub Ինչպե՞ս կարող եմ ավելացնել երկրորդ աշխատանքային թերթիկ, որպեսզի տողերը տեղափոխվեն sheet2:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ի՞նչ պետք է մուտքագրեմ, եթե ուզում եմ որևէ ամսաթիվ ներառել որպես իմ արժեք: Այսպիսով, տողը մնում է 1-ին թերթի վրա, եթե այն չունի ամսաթիվ, և տեղափոխվում է թերթ 2, եթե ունի:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
[quote]Ողջույն, սա շատ օգտակար էր: Արդյո՞ք դա անելու միջոց կա առանց տվյալների շարքը երկրորդ թերթիկ տեղափոխելու, այլ այն պատճենելու: Այսպիսով, տվյալները կմնա՞ն երկու թերթիկների վրա:Մեդիի կողմից[/quote] ինչ-որ մեկը լուծել է դա
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հեռացրեք այս «xCell.EntireRow.Delete»-ը ծածկագրից
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Երբ ես ջնջում եմ կոդի այդ տողը և նորից գործարկում մակրո, Excel-ը սառեցնում է: Ինչու և ինչպես շտկեմ դա?? Ես ուզում եմ, որ տվյալները լինեն երկու աշխատաթերթերում և չջնջվեն բնօրինակից: TIA
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
կա՞ սրա պատասխանը Իմը նույնպես սառչում է, ես կցանկանայի պատճենել, բայց ոչ ջնջել տողը
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Լավ օր,
Ստորև բերված VBA կոդը կարող է օգնել ձեզ միայն պատճենել տողերը՝ դրանք ջնջելու փոխարեն:

Sub Cheezy ()
Dim xRg որպես տիրույթ
Dim xCell-ը որպես տիրույթ
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets ("Sheet1").UsedRange.Rows.Count
J = Worksheets ("Sheet2").UsedRange.Rows.Count
Եթե ​​J = 1 Ապա
Եթե ​​Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Ապա J = 0
Վերջ: Եթե
Սահմանել xRg = Աշխատանքային թերթիկներ («Թերթ 1»). միջակայք («C1:C» և I)
Ս.թ. սխալի Ռեզյումե Next
Դիմում. ScreenUpdating = Սուտ է
K = 1-ի համար դեպի xRg.Count
If CStr(xRg(K).Value) = «Կատարված է» Ապա
xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
J = J + 1
Վերջ: Եթե
հաջորդ
Դիմում. ScreenUpdating = ueիշտ է
Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, ես այս տարբերակի տարբերակ եմ փնտրում: Ինձ պետք է, որ սկրիպտը շարունակաբար աշխատի, կամ այն ​​ձախողվի, երբ տվյալ դաշտի արժեքը փոխվի: Կոդն ինքնին աշխատում է, բայց պետք է գործարկվի ինքնուրույն: Ես կցանկանայի, որ այն ավտոմատացված լինի: Որևէ մեկը կարո՞ղ է օգնել:

Որպես մի կողմ, եթե ես միայն ուզում եմ, որ այն պատճենվի տիրույթի որոշակի բջիջների վրա, ինչպե՞ս է դա արվում:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հարգելի Ռոբ,

Եթե ​​Ձեզ անհրաժեշտ է, որ սկրիպտը գործարկվի ավտոմատ կերպով, երբ այդ դաշտի բջիջները փոխվեն, ստորև ներկայացված VBA կոդը կարող է օգնել ձեզ: Խնդրում ենք աջ սեղմել ընթացիկ թերթիկը (տողերով թերթը, որը դուք ավտոմատ կերպով կտեղափոխեք) ներդիրին, այնուհետև համատեքստի ընտրացանկից ընտրեք Դիտել կոդը: Այնուհետև պատճենեք և տեղադրեք ստորև VBA սկրիպտը Code պատուհանում:

Private Sub Worksheet_Change (ByVal Target as Range)

Dim xCell-ը որպես տիրույթ

Dim I As Long
Ս.թ. սխալի Ռեզյումե Next

Դիմում. ScreenUpdating = Սուտ է

Սահմանել xCell = Թիրախ (1)
If xCell.Value = «Կատարված է» Ապա
I = Worksheets ("Sheet2").UsedRange.Rows.Count
Եթե ​​ես = 1 Ապա

Եթե ​​Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Հետո ես = 0

Վերջ: Եթե

xCell.EntireRow.Copy Worksheets("Sheet2").Range("A" & I + 1)

xCell.EntireRow.Delete
Վերջ: Եթե

Դիմում. ScreenUpdating = ueիշտ է

Վերջ Sub


Ձեր երկրորդ հարցի համար նկատի ունեք ընդամենը մի քանի բջիջ պատճենե՞լ ամբողջ տողի փոխարեն: Կամ խնդրում եմ տրամադրեք ձեր հարցի սքրինշոթը: Շնորհակալություն!

Հարգանքներով՝ Crystal
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
բյուրեղյա,


Ձեր օգնությունն ավելի շատ է, քան անհրաժեշտ է :)



Ինչպես կարող ենք այստեղ ավելացնել ևս մեկ crtieria, օրինակ, ես կցանկանայի փոխանցել Ավարտված է Կատարվածի կողքին:


Private Sub Worksheet_Change (ByVal Target as Range)

Dim xCell-ը որպես տիրույթ

Dim I As Long
Ս.թ. սխալի Ռեզյումե Next

Դիմում. ScreenUpdating = Սուտ է

Սահմանել xCell = Թիրախ (1)
If xCell.Value = «Կատարված է» Ապա
I = Worksheets ("Sheet2").UsedRange.Rows.Count
Եթե ​​ես = 1 Ապա

Եթե ​​Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Հետո ես = 0

Վերջ: Եթե

xCell.EntireRow.Copy Worksheets("Sheet2").Range("A" & I + 1)

xCell.EntireRow.Delete
Վերջ: Եթե

Դիմում. ScreenUpdating = ueիշտ է

Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Կրիստալ
Սա ամենաօգտակար տեղեկատվությունն է, որը ես գտել եմ համացանցում, և այս մակրոն անում է այն, ինչ ուզում եմ: Բայց ես տողերը տեղափոխում եմ մի աղյուսակից մյուս աղյուսակ, և այս մակրոյով տեղեկատվությունը տեղափոխվում է աղյուսակից դուրս առաջին ազատ տողով, այլ ոչ թե աղյուսակի հաջորդ ազատ տողով: Կարող եք օգնել?
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ես գործարկում եմ այս կոդը և փորձում եմ տեղափոխել տող՝ հիմնվելով I սյունակում հայտնվող այսօրվա ամսաթվի վրա. ես փոխել եմ Range("B1:B" & I)՝ կարդալու Range(I1:I" & I): Ես փոխել եմ " Կատարված է» ձեր օրինակում մինչև ամսաթիվ: Այնուամենայնիվ, երբ այսօրվա ամսաթիվը հայտնվում է տողում որևէ տեղ, ոչ միայն I սյունակում, ինչպես պահանջվում է, տողը տեղափոխվում է այլընտրանքային աշխատաթերթ: Ցանկացած պատկերացում, թե ինչու է դա տեղի ունենում, և ինչպես կարող եմ տողը տեղափոխել: միայն այն դեպքում, երբ այսօրվա ամսաթիվը I սյունակում է, անկախ նրանից, թե այսօրվա ամսաթիվը այլ սյունակներում է հայտնվում:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հարգելի Դավիթ,

Կոդն ինձ համար լավ է աշխատում միջակայքը և փոփոխական արժեքը մինչ օրս փոխելուց հետո: Ձեր կոդի ամսաթվի ձևաչափը պետք է համապատասխանի աշխատաթերթում օգտագործած ամսաթվի ձևաչափին: Թե՞ ձեզ հարմար է ձեր աշխատաթերթը կցելը։
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Կրիստալ,


Ես պարզ չեմ, թե ինչ նկատի ունեք, երբ ասում եք, որ ծածկագրի և աղյուսակի ամսաթվերի ձևաչափերը պետք է համընկնեն. ես VB փորձագետ չեմ, ավելի շուտ՝ սկսնակ մակարդակ: Իմ աղյուսակում ես այսօրվա ամսաթիվը մուտքագրում եմ F սյունակում՝ որպես տողի մուտքի ամսաթիվ՝ ctrl + : ձևաչափով: «I» սյունակում պիտանելիության ժամկետը մուտքագրում եմ մմ/օր/տտտ ձևաչափով: Այնուամենայնիվ, սա խնդիրներ է առաջացնում նոր տող մուտքագրելիս և այսօրվա ամսաթիվը F սյունակում մուտքագրելիս, քանի որ այն մուտքագրվելուն պես տողը տեղափոխվում է նոր աշխատաթերթ: Բացի այդ, աշխատանքային գրքույկը բացելիս գործարկվող լրացուցիչ կոդը չի երևում: վազել առանց ես ստիպելու դա անել: Կներեք, թե ինչ կարող է լինել ձեզ համար շատ աննշան խնդիրների համար, բայց ես պարզապես չեմ կարող լսել այս հարցերի շուրջ: Ցանկացած օգնություն կգնահատվի:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հարգելի Դավիթ,

Ես փորձել եմ հենց այնպես, ինչպես վերը նշեցիր, բայց հարցի դոզան իմ դեպքում չի երևում։ Կարող եք տրամադրել ձեր Excel տարբերակը: Ինձ ավելի շատ տեղեկություններ է պետք, որպեսզի օգնեմ լուծել այս խնդիրը: Կներեք ձեզ նորից անհանգստացնելու համար:

Հարգանքներով՝ Crystal
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Crystal, սրանք աշխատանքային թերթիկներն են: Պատճենված կոդում կտեսնեք, որ ես փնտրում եմ «մինչև» այսօրվա ամսաթիվը L սյունակում, և եթե «մինչև» ամսաթիվը և ներառյալ այսօրվա ամսաթիվը նշված է սյունակում, ապա ես ուզում եմ տեղափոխել այդ ամսաթիվը պարունակող տողը նոր աշխատաթերթ: Ներկայումս, երբ ես մուտքագրում եմ այսօրվա ամսաթիվը տողում ցանկացած կետում (օրինակ F սյունակ, եթե այսօր միջնորդություն է տրվել), այն ավտոմատ կերպով տեղափոխում է ամբողջ տողը արխիվացված աղյուսակ: Ես սովորաբար մուտքագրում եմ այսօրվա ամսաթիվը՝ օգտագործելով ctrl + : համակցությունը, սովորաբար F սյունակում:
Բացի այդ, ես կցանկանայի, որ այս քայլը կատարվեր աշխատանքային գրքույկը բացելիս: Ներկայումս ես պետք է գնամ ցուցադրելու կոդը, այնուհետև սեղմեմ F5: Ցանկացած խորհուրդ, թե ինչպես դա անել, ողջունելի կլինի:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ցավոք, իմ մակրո միացված աշխատանքային գիրքը չի վերբեռնվի, քանի որ այն ասում է, որ ձևաչափը չի աջակցվում: Սրանք Excel 2016-ում են
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հարգելի Դավիթ,

Հետևյալ VBA կոդը կարող է օգնել ձեզ հասնել դրան:

Մասնավոր ենթագիրք_Բաց()
Dim xRg որպես տիրույթ
Dim xCell-ը որպես տիրույթ
Dim I As Long
Dim J As Long
I = Worksheets ("CURRENT OASIS OPPORTUNITIES").UsedRange.Rows.Count
J = Աշխատանքային թերթիկներ («ԱՐԽԻՎԱԾ ՕԱԶԻ ՀՆԱՐԱՎՈՐՈՒԹՅՈՒՆՆԵՐ»).UsedRange.Rows.Count
Եթե ​​J = 1 Ապա
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 Ապա J = 0
Վերջ: Եթե
Սահմանել xRg = Աշխատանքային թերթիկներ («ԸՆԹԱՑԻԿ ՕԱԶԻ ՀՆԱՐԱՎՈՐՈՒԹՅՈՒՆՆԵՐ»). միջակայք («L1:L» և I)
Ս.թ. սխալի Ռեզյումե Next
Դիմում. ScreenUpdating = Սուտ է
Յուրաքանչյուր xCell-ի համար xRg-ում
Եթե ​​CStr(xCell.Value) = Date then
xCell.EntireRow.Պատճենել նպատակակետը՝=Աշխատանքային թերթիկներ(«ԱՐԽԻՎՎԱԾ ՕԱԶԻՍԻ ՀՆԱՐԱՎՈՐՈՒԹՅՈՒՆՆԵՐ»).Տարածք («A» և J + 1)
xCell.EntireRow.Delete
J = J + 1
Վերջ: Եթե
հաջորդ
Վերջ Sub

Նշումներ:
1. Դուք պետք է տեղադրեք VBA սկրիպտը ThisWorkbook կոդը պատուհանում;
2. Ձեր աշխատանքային գրքույկը պետք է պահպանվի որպես Excel մակրո-միացված աշխատանքային գրքույկ:

Վերոնշյալ գործողությունից հետո, ամեն անգամ, երբ բացում եք աշխատանքային գիրքը, մի ամբողջ տող կտեղափոխվի ԱՐԽԻՎՎԱԾ աշխատաթերթ, եթե L սյունակի բջիջը հասնի այսօրվա ամսաթվին:

Beast Regards, Crystal
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Շնորհակալություն Crystal,
Սա հիանալի է աշխատում, եթե այսօրվա ամսաթիվը նշված է L սյունակում: Արդյո՞ք որևէ միջոց կա մինչև այսօրվա ամսաթիվը ներառել նաև L սյունակում, որպեսզի, եթե ես մի քանի օր չստուգեմ աշխատանքային գրքույկը, այն ավտոմատ կերպով ներառի ավելի վաղ ժամկետները: այսօրվա? Շատ շնորհակալ եմ ձեր օգնության համար.
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հարգելի Դավիթ,

Կներեք, ես վստահ չեմ, որ ստացել եմ ձեր հարցը: Եթե ​​այո, ապա բոլոր տողերը կտեղափոխվեն այնքան ժամանակ, քանի դեռ ավելի վաղ ամսաթվերը հայտնվում են L սյունակում:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Կրիստալ,

Եթե ​​ես մի քանի օր չբացեմ իմ աշխատանքային թերթիկը, և L սյունակում մուտքագրված ամսաթիվն արդեն անցել է, այսինքն՝ L սյունակի բջիջի ամսաթիվը 11թ. սեպտեմբերի 2017-ն է, բայց մինչև սեպտեմբերի 13-ը չբացեմ իմ աշխատաթերթը, ես կբացեմ: ինչպես L սյունակի բոլոր գրառումները, որոնք պետք է ստուգվեն յուրաքանչյուր ամսաթվի համար մինչև այսօրվա ամսաթիվը, ապա համապատասխան տողերը տեղափոխեք նոր թերթ: Ներկայումս ձեր բարեխղճորեն տրամադրած կոդով միայն L սյունակի ընթացիկ ամսաթվով տողերը տեղափոխվում են նոր թերթ՝ թողնելով L սյունակի ավելի վաղ ամսաթվով տողերը, որոնք ես այժմ ձեռքով տեղափոխում եմ նոր թերթ: Շնորհակալություն ձեր օգնության համար:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հարգելի Դավիթ,



Ես հասկանում եմ ձեր տեսակետը: Խնդրում ենք փորձել ստորև ներկայացված VBA սկրիպտը: Աշխատանքային գրքույկը բացելիս L սյունակի մինչև այսօրվա ամսաթվերով բոլոր տողերը կտեղափոխվեն նոր նշված թերթ:



Մասնավոր ենթագիրք_Բաց()
Dim xRg որպես տիրույթ
Dim xRgRtn As Range
Dim xCell-ը որպես տիրույթ
Dim xLastRow այնքան երկար
Dim I As Long
Dim J As Long
Ս.թ. սխալի Ռեզյումե Next
xLastRow = Worksheets ("CURRENT OASIS OPPORTUNITIES").UsedRange.Rows.Count
Եթե ​​xLastRow < 1 Ապա Ելք Ենթ
J = Աշխատանքային թերթիկներ («ԱՐԽԻՎԱԾ ՕԱԶԻ ՀՆԱՐԱՎՈՐՈՒԹՅՈՒՆՆԵՐ»).UsedRange.Rows.Count
Եթե ​​J = 1 Ապա
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 Ապա J = 0
Վերջ: Եթե
Սահմանել xRg = Աշխատանքային թերթիկներ («ԸՆԹԱՑԻԿ ՕԱԶԻ ՀՆԱՐԱՎՈՐՈՒԹՅՈՒՆՆԵՐ»). միջակայք («L1:L» և xՎերջին տող)
I = 2-ի համար դեպի xLastRow
Եթե ​​xRg(I).Արժեք > Ամսաթիվ Ապա Ելք Ենթ
Եթե ​​xRg(I).Value <= Date then
xRg(I).EntireRow.Պատճենել նպատակակետը՝=Աշխատանքային թերթիկներ(«ԱՐԽԻՎԱԾ ՕԱՍԻՍԻ ՀՆԱՐԱՎՈՐՈՒԹՅՈՒՆՆԵՐ»).Range(«A» & J + 1)
xRg(I).EntireRow.Delete
J = J + 1
I = I - 1
Վերջ: Եթե
հաջորդ
Վերջ Sub

Դուք պետք է տեղադրեք VBA սկրիպտը ThisWorkbook կոդի պատուհանում և պահեք աշխատանքային գիրքը որպես Excel մակրո-միացված աշխատանքային գրքույկ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Շնորհակալություն Crystal, դա լավ է աշխատում:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Crystal, ես մի փոքր շտապեցի պատասխանել, որ կոդը աշխատում է: Ես այսօր բացեցի իմ աշխատանքային գրքույկը, և L սյունակում նախորդ ամսաթվերի գրառումները պարունակող տողերը դեռևս գտնվում են «օազիսի ընթացիկ հնարավորությունների աշխատաթերթում» և չեն տեղափոխվել «արխիվացված օազիսի աշխատաթերթ», ինչպես սպասվում էր: Կա՞ պատկերացում, թե ինչու դա այդպես կլինի:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ընդգծված բջիջները գտնվում են L սյունակում՝ վերը նշված հարցի առնչությամբ և հանդիսանում են տողը նոր աշխատաթերթ տեղափոխելու չափանիշները (մինչև այսօր): Հուսով եմ, որ այս պատկերն օգնում է:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Սա նաև վերը նշվածի հետ կապված VBA պատուհանի պատճենն է:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Crystal, ես մի փոքր շտապեցի պատասխանել, որ կոդը աշխատում է: Ես այսօր բացեցի իմ աշխատանքային գրքույկը, և L սյունակում նախորդ ամսաթվերի գրառումները պարունակող տողերը դեռևս գտնվում են «օազիսի ընթացիկ հնարավորությունների աշխատաթերթում» և չեն տեղափոխվել «արխիվացված օազիսի աշխատաթերթ», ինչպես սպասվում էր: Կա՞ պատկերացում, թե ինչու դա այդպես կլինի:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
բյուրեղյա,

Քանի որ ես չեմ կարող վերբեռնել իմ աշխատանքային գիրքը, ես այստեղ կվերարտադրեմ տողերն ու սյունակները

ԱԲԳԴԵՖՂԻՋԿԼ
# Type Set-Aside Solicitation Փոփոխել # Թողարկման Ամսաթիվ Հարցեր Հաճախորդների Առաքման Տեղ Նախագծի Առաջարկը Ժամկետ

1 SS SB 1234567 1 09/6/17 No Army Անուն Վայր Տանկ Տանկ 09/10/17

Օգտագործելով ստորև բերված կոդը՝ ես ուզում եմ, որ այն տեղափոխի մի ամբողջ տող նոր աշխատաթերթ, երբ L սյունակը հասնի այսօրվա ամսաթվին: Նաև, եթե ես չեմ լրացրել աշխատանքային թերթիկը մի քանի օր շարունակ, ես կցանկանայի, որ այն օգտագործի «մինչև այսօրվա ամսաթիվը» որոնումը սյունակ L-ում՝ նույնն անելու համար: Ես նաև կցանկանայի, որ դա անի ավտոմատ կերպով, երբ ես բացում եմ աշխատանքային գիրքը, եթե հնարավոր է: Ներկայումս, եթե ես այսօրվա ամսաթիվը մուտքագրեմ տողի ցանկացած բջիջում, օրինակ F սյունակում տվյալներ մուտքագրելիս, ամբողջ տողը տեղափոխվում է արխիվի աշխատաթերթ: (Օգտագործելով Excel 2016)

[Մոդուլի 1 կոդը]

Sub DaveV ()

Dim xRg որպես տիրույթ

Dim xCell-ը որպես տիրույթ

Dim I As Long

Dim J As Long

I = Worksheets ("CURRENT OASIS OPPORTUNITIES").UsedRange.Rows.Count

J = Աշխատանքային թերթիկներ («ԱՐԽԻՎԱԾ ՕԱԶԻ ՀՆԱՐԱՎՈՐՈՒԹՅՈՒՆՆԵՐ»).UsedRange.Rows.Count

Եթե ​​J = 1 Ապա
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 Ապա J = 0

Վերջ: Եթե

Սահմանել xRg = Աշխատանքային թերթիկներ («ԸՆԹԱՑԻԿ ՕԱԶԻ ՀՆԱՐԱՎՈՐՈՒԹՅՈՒՆՆԵՐ»). միջակայք («L1:L» և I)

Ս.թ. սխալի Ռեզյումե Next

Դիմում. ScreenUpdating = Սուտ է

Յուրաքանչյուր xCell-ի համար xRg-ում

Եթե ​​CStr(xCell.Value) = Date then

xCell.EntireRow.Պատճենել նպատակակետը՝=Աշխատանքային թերթիկներ(«ԱՐԽԻՎՎԱԾ ՕԱԶԻՍԻ ՀՆԱՐԱՎՈՐՈՒԹՅՈՒՆՆԵՐ»).Տարածք («A» և J + 1)
xCell.EntireRow.Delete

J = J + 1
Վերջ: Եթե

հաջորդ
Դիմում. ScreenUpdating = ueիշտ է

Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
[Թերթ 1 կոդը]

Private Sub Worksheet_Change (ByVal Target as Range)
Dim xCell-ը որպես տիրույթ
Dim I As Long
Ս.թ. սխալի Ռեզյումե Next
Դիմում. ScreenUpdating = Սուտ է
Սահմանել xCell = Թիրախ (1)
Եթե ​​xCell.Value = Ամսաթիվ Հետո
I = Աշխատանքային թերթիկներ («ԱՐԽԻՎԱԾ ՕԱԶԻ ՀՆԱՐԱՎՈՐՈՒԹՅՈՒՆՆԵՐ»).UsedRange.Rows.Count
Եթե ​​ես = 1 Ապա
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 Հետո ես = 0 Ավարտ, եթե
xCell.EntireRow.Copy Worksheets («ARCHIVED OASIS OPPORTUNITIES»): Range («A» & I + 1)
xCell.EntireRow.Delete
Վերջ: Եթե
Դիմում. ScreenUpdating = ueիշտ է
Վերջ Sub

Հուսով եմ, որ վերը նշվածը կօգնի, բայց ես VBA մարդ չեմ, հետևաբար չեմ հասկանում, թե ինչպես ստիպել կոդը անել այն, ինչ ինձ անհրաժեշտ է: Ձեր օգնությունը կգնահատվի:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ձեր սցենարում մեծ սխալ կա:

Ասեք, որ հայտնաբերել եք, որ 7-րդ տողում կա «Կատարված» բառը C սյունակում, այնպես որ դուք պատճենեք այն և ջնջեք տողը:
Երբ դուք ջնջեցիք տողը, ցուցակի հաջորդ տողը կլինի 9-րդ տողը և ոչ թե 8-ը, քանի որ երբ հանեցիք 7-րդ տողը, այժմ 8-րդ տողի բովանդակությունը 7-րդ տողում է, և բոլոր տողերը բարձրացել են 1 տողով: Այսպիսով, հաջորդ տողը, որը պետք է ստուգվի, պետք է լիներ #8-րդ շարքը, բայց այժմ այն ​​պարունակում է այն տվյալները, որոնք նախկինում եղել են #9-րդ տողում, այնպես որ ամեն անգամ, երբ դուք ջնջում եք տող, դուք իրականում բաց եք թողնում ստուգելու տող!!!
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հարգելի Շաու Ալոն,

Շնորհակալություն մեկնաբանության համար։ Կոդը թարմացվել է՝ շտկված սխալով: Շատ շնորհակալ եմ ձեր օգնականի համար:

Հարգանքներով՝ Crystal
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Կարծում եմ, որ դա տեղի է ունենում ինձ հետ, այն շարունակում է կրկնօրինակել նույն շարքը, թեև ասում է, որ կոդը թարմացվել է: Սա այն է, ինչ ես ունեմ.

Sub Cheezy ()
«Թարմացվել է Kutools-ի կողմից Excel 2017/8/28-ի համար
Dim xRg որպես տիրույթ
Dim xCell-ը որպես տիրույթ
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets ("PRUCHASE FORCAST").UsedRange.Rows.Count
J = Worksheets ("Purchase Archive").UsedRange.Rows.Count
Եթե ​​J = 1 Ապա
If Application.WorksheetFunction.CountA(Worksheets("Purchase Archive").UsedRange) = 0 Ապա J = 0
Վերջ: Եթե
Սահմանել xRg = Աշխատանքային թերթիկներ («ԳՆԵԼՈՒ ԿԱՆԽԱՏԵՍՈՒՄ»). միջակայք («H3:H» և I)
Ս.թ. սխալի Ռեզյումե Next
Դիմում. ScreenUpdating = Սուտ է
K = 1-ի համար դեպի xRg.Count
Եթե ​​CStr(xRg(K).Value) = «Այո» Ապա
xRg(K).EntireRow.Copy Destination:=Worksheets("Purchase Archive").Range("A" & J + 1)
xRg(K).EntireRow.Delete
Եթե ​​CStr(xRg(K).Value) = «Այո» Ապա
K = K - 1
Վերջ: Եթե
J = J + 1
Վերջ: Եթե
հաջորդ
Դիմում. ScreenUpdating = ueիշտ է
Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Ֆրեդ,
Ամեն անգամ, երբ գործարկում եք կոդը, կոդը որոնում է նշված տիրույթը, ուստի այն կրկնօրինակում է նույն տողը նորից ու նորից, քանի որ չի կարող ասել, թե որ տողն է արդեն պատճենված: Միևնույն տողը բազմիցս կրկնելուց խուսափելու համար կարող եք կոդն ինքնաբերաբար գործարկել, երբ նշված բջիջում համապատասխան արժեք մուտքագրվի:
«ԳՆԵԼ FORCAST» անունով աշխատաթերթում աջ սեղմեք թերթի ներդիրին և սեղմեք Դիտել կոդը համատեքստի ընտրացանկից: Այնուհետև պատճենեք հետևյալ VBA ծածկագիրը Sheet (Code) պատուհանում:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated by Kutools for Excel 20220830
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("PURCHASE FORCAST").UsedRange.Rows.Count
J = Worksheets("Purchase Archive").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Purchase Archive").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("PURCHASE FORCAST").Range("H3:H" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Yes" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Purchase Archive").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Yes" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ինչ-որ մեկը կարո՞ղ է օգնել ինձ այս աշխատանքը կատարել: Ես փորձել եմ փոխել այն մասը, որը պետք է համապատասխանի իմ ֆայլին, բայց դա ի հայտ է գալիս, և ես վստահ չեմ, թե ինչ անել:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
այն ասում է, որ ֆայլը չի ​​աջակցվում, երբ ես փորձում եմ վերբեռնել excel ֆայլը: Ներողություն ... այսօր պայքարում եմ դրա հետ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ես կցանկանայի օգնություն նմանատիպ առաջադրանքի համար, բայց մի փոքր այլ: Ես ունեմ թվերի 5 սյունակ, մոտ 25000 յուրաքանչյուր սյունակում, յուրաքանչյուր սյունակ 1-5 վերնագրով: Ես կցանկանայի պատճենել ամբողջ տողը մեկ այլ թերթիկի վրա, եթե սյունակ 1-ի արժեքը զրոյից մեծ է, ԿԱՄ սյունակ 2-ը զրոյից մեծ է: , ԿԱՄ 3-րդ սյունակը զրոյից փոքր է, ԿԱՄ 4-րդ սյունակը հինգից մեծ է ԿԱՄ 5-րդ սյունակը երկուսից մեծ է և այլն: Սա հնարավո՞ր է:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
պատկերի վերբեռնումը չի աշխատում... կներեք:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարեւ,
Խնդրում ենք օգտագործել այս մեկի վերբեռնման կոճակը:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Այսպիսով, նպատակն է տեսնել, թե արդյոք գազերից որևէ մեկը գերազանցում է այն սահմանը, որը ես կսահմանեմ բանաձևում, ամբողջ ցուպիկը ԿՈՊԻՎՎՈՒՄ է նոր թերթիկի վրա:

Շատ շնորհակալ եմ ցանկացած օգնության համար:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Պատկերը կցված է
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հարգելի Միքայել,
Միգուցե դուք կարող եք լուծել այս խնդիրը՝ օգտագործելով Excel հավելումը: Այստեղ ես ձեզ խորհուրդ եմ տալիս Excel-ի համար Kutools-ի Ընտրել հատուկ բջիջներ: Այս օգտակար ծրագրի միջոցով դուք հեշտությամբ կարող եք ընտրել բոլոր տողերը որոշակի տիրույթում, եթե նշված սյունակի արժեքը մեծ է կամ փոքր է, քան թիվը: Բոլոր անհրաժեշտ տողերն ընտրելուց հետո կարող եք ձեռքով պատճենել և տեղադրել դրանք նոր աշխատաթերթում: Տես ստորև կից պատկերը։

Դուք կարող եք ավելին իմանալ այս հատկության մասին՝ հետևելով ստորև նշված հիպերհղմանը:
https://www.extendoffice.com/product/kutools-for-excel/excel-select-specific-cells-rows.html
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
շնորհակալություն այս բանաձևի համար, բայց ես խնդիր ունեի, երբ ես ուզում եմ տողը տեղափոխել մեկ այլ թերթիկ, դա ինքնաբերաբար չի լինում: կարո՞ղ եք ինձ այլ բանաձև տալ: այնպես որ, երբ ես փոխում եմ բջիջի արժեքը, այն ավտոմատ կերպով շարժվում է:


շնորհակալություն
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հարգելի Ջանանգ,
Կոդի չափաբաժինը ինքնաբերաբար չի ստացվում, քանի դեռ ձեռքով չեք գործարկել գործարկման կոճակը:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջու՜յն,

Ես կցանկանայի, որ այս մակրոն ստեղծվեր, բայց 2 արգումենտով: Ես կարողացա այնպես անել, որ մակրոն աշխատի իմ ֆայլում՝ ելնելով O սյունակի բջիջների արժեքից: Այնուամենայնիվ, ես կցանկանայի, որ Macro-ն ստուգի, թե արդյոք S սյունակը նույնպես լրացված է (կամ <> «»), նախքան տողը տեղափոխելը: . Ի վերջո, ես նույնպես կցանկանայի, որ պատճենված տողերը լինեն նույն ձևաչափով, ինչ երկրորդ թերթի տողերը: Արդյո՞ք դա ամբողջությամբ փոխում է մակրոնը:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հարգելի Հյուգեր,
Ես չգիտեմ, թե արդյոք ճիշտ եմ հասկանում քեզ: Ուզում եք ասել, որ եթե S սյունակի բջիջը լրացված է, իսկ O սյունակի բջիջը միաժամանակ պարունակում է որոշակի արժեք, ապա տողը տեղափոխեք ֆորմատավորումով: Հակառակ դեպքում չշարժվե՞ք։
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Կրիստալ,

Այո, դա հենց այն է, ինչ նկատի ունեմ: Իրականում իմ տվյալները նախագծերի մասին են։ Իմ O սյունակը իմ նախագծի կարգավիճակն է, իսկ S-ը՝ իմ նախագծի ավարտի ամսաթիվը:
Ես ուզում եմ, որ իմ օգտատերերը, այն մարդիկ, ովքեր ունեն տեղեկատվություն և պետք է այն տեղադրեն, կարողանան «Արխիվացնել» նախագիծը ՄԻԱՅՆ, եթե ունեն իրենց «Փակ» կարգավիճակը և տեղադրեն «Ավարտման ամսաթիվ»:


Հուսով եմ, որ սա կօգնի պարզաբանել բաները
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հարգելի Հյուգեր,
Կներեք այդքան ուշ պատասխանելու համար։ Հետևյալ VBA կոդը կարող է օգնել ձեզ լուծել խնդիրը: Խնդրում ենք հետևել այս հոդվածի քայլերին՝ VBA սկրիպտը կիրառելու համար:

Sub MoveRowBasedOnCellValue()
Dim xRgStatus-ը որպես միջակայք
Dim xRgDate As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets ("Sheet1").UsedRange.Rows.Count
J = Worksheets ("Sheet2").UsedRange.Rows.Count
Եթե ​​J = 1 Ապա
Եթե ​​Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Ապա J = 0
Վերջ: Եթե
Սահմանել xRgStatus = Աշխատանքային թերթիկներ («Թերթ 1»). միջակայք («O1:O» և I)
Սահմանել xRgDate = Աշխատանքային թերթիկներ («Թերթ 1»). միջակայք («S1:S» և I)
Ս.թ. սխալի Ռեզյումե Next
Դիմում. ScreenUpdating = Սուտ է
Application.CutCopyMode = Կեղծ է
xRgStatus(1).EntireRow.Copy
Աշխատանքային թերթիկներ ("Sheet2"). Range ("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
K = 2-ի համար դեպի xRgStatus.Count
Եթե ​​CStr(xRgStatus(K).Value) = «Փակ է» Ապա
If (xRgDate(K).Value <> "") And (TypeName(xRgDate(K).Value) = "Date") Ապա
xRgStatus(K).EntireRow.Copy
Աշխատանքային թերթիկներ ("Sheet2"). Range ("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
Վերջ: Եթե
Վերջ: Եթե
հաջորդ
Application.CutCopyMode = Ճշմարիտ
Դիմում. ScreenUpdating = ueիշտ է
Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հարգելի Կրիստալ,

Շատ շնորհակալ եմ ձեր օգնության համար:

Regards,

Հյուզ
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարեւ,


Ինչպե՞ս կարող եմ պատճենել տողերը դրանք տեղափոխելու փոխարեն:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարեւ,


Ես գիտեմ, որ սա մի քանի անգամ տեղադրվել է, բայց ես չեմ կարող գտնել պատասխանը: Ինչպե՞ս կարող եմ նյութը պատճենել նոր թերթում և ՉՋնջել այն բնօրինակ թերթիկից:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հարգելի՛ Մայք
Եթե ​​ցանկանում եք պատճենել տողերը դրանք ջնջելու փոխարեն, ստորև ներկայացված VBA կոդը կարող է օգնել ձեզ: Շնորհակալություն մեկնաբանության համար:

Sub Cheezy ()
Dim xRg որպես տիրույթ
Dim xCell-ը որպես տիրույթ
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets ("Sheet1").UsedRange.Rows.Count
J = Worksheets ("Sheet2").UsedRange.Rows.Count
Եթե ​​J = 1 Ապա
Եթե ​​Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Ապա J = 0
Վերջ: Եթե
Սահմանել xRg = Աշխատանքային թերթիկներ («Թերթ 1»). միջակայք («C1:C» և I)
Ս.թ. սխալի Ռեզյումե Next
Դիմում. ScreenUpdating = Սուտ է
K = 1-ի համար դեպի xRg.Count
If CStr(xRg(K).Value) = «Կատարված է» Ապա
xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
J = J + 1
Վերջ: Եթե
հաջորդ
Դիմում. ScreenUpdating = ueիշտ է
Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջու՜յն,

Ես նոր եմ օգտագործել մակրոները, հնարավո՞ր է ստորև նշված տվյալները տեղադրել որոշակի արժեքից հետո և կկրկնվեն մինչև սյունակի վերջը:
Սրա նման:

Փոխանցել «Կապույտ»-ը «Գույն»-ից հետո

A1 = Կապույտ
A5 = Գույն
A6= (փոխանցել «Կապույտ» այստեղ)
եւ այլն ...
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հարգելի Johnոն,
Ուզում եք ասել, որ եթե բջիջը պարունակում է «Գույն» սյունակում, ապա պատճենեք առաջին բջիջի տեքստը «Գույնի» ներքևի բջիջում և կրկնեք այս տեքստը մինչև սյունակի վերջը:
Առայժմ ոչ մի մեկնաբանություն չկա
Բեռնել More

Հետեւեք մեզ

Հեղինակային իրավունքի © 2009 - www.extendoffice.com. | Բոլոր իրավունքները պաշտպանված են. Powered by ExtendOffice. | | Կայքի քարտեզ
Microsoft- ը և Office- ի պատկերանշանը հանդիսանում են Microsoft Corporation- ի ապրանքային նշաններ կամ գրանցված ապրանքային նշաններ ԱՄՆ-ում և (կամ) այլ երկրներում:
Պաշտպանված է Sectigo SSL- ի կողմից