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

Ինչպե՞ս կրկնօրինակել տողերը ՝ հիմնվելով սյունակում բջջային արժեքի վրա:

Օրինակ, ես ունեմ տվյալների մի շարք, որը պարունակում է թվերի ցուցակ D սյունակում, և այժմ ես ուզում եմ կրկնօրինակել ամբողջ շարքերը մի շարք անգամ `հիմնվելով D սյունակի թվային արժեքների վրա` հետևյալ արդյունքը ստանալու համար: Ինչպե՞ս կարող էի Excel- ում բջիջների արժեքների հիման վրա բազմիցս պատճենել տողերը:

փաստաթուղթ կրկնօրինակ տողեր ըստ բջիջի 1-ի

VBA կոդով բջջային արժեքների հիման վրա բազմակի կրկնօրինակեք տողերը


նետ կապույտ աջ պղպջակ VBA կոդով բջջային արժեքների հիման վրա բազմակի կրկնօրինակեք տողերը

Բջջային արժեքների հիման վրա ամբողջ շարքերը բազմակի պատճենելու և կրկնօրինակելու համար հետևյալ VBA կոդը կարող է օգնել ձեզ, խնդրում ենք արեք հետևյալ կերպ.

1, Պահեք պահեք ALT + F11 բացել ստեղները Microsoft Visual Basic հավելվածների համար պատուհան.

2: Սեղմեք Տեղադրել > Մոդուլներ, և տեղադրեք հետևյալ կոդը Մոդուլներ Պատուհանը:

VBA կոդ. Կրկնօրինակ տողեր բազմիցս `ելնելով բջջային արժեքից.

Sub CopyData()
'Updateby Extendoffice
    Dim xRow As Long
    Dim VInSertNum As Variant
    xRow = 1
    Application.ScreenUpdating = False
    Do While (Cells(xRow, "A") <> "")
        VInSertNum = Cells(xRow, "D")
        If ((VInSertNum > 1) And IsNumeric(VInSertNum)) Then
           Range(Cells(xRow, "A"), Cells(xRow, "D")).Copy
           Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "D")).Select
           Selection.Insert Shift:=xlDown
           xRow = xRow + VInSertNum - 1
        End If
        xRow = xRow + 1
    Loop
    Application.ScreenUpdating = False
End Sub

3, Դրանից հետո սեղմեք F5 Այս ծածկագիրը գործարկելու համար ստեղնաշարի ամբողջ տողերը բազմակի անգամ կրկնօրինակվել են ՝ հիմնվելով D սյունակում գտնվող բջջային արժեքի վրա, որքան անհրաժեշտ է:

ՆշումՎերոհիշյալ ծածկագրում `նամակը A նշում է ձեր տվյալների տիրույթի մեկնարկի սյունակը և տառը D սյունակի նամակն է, որի հիման վրա ցանկանում եք կրկնօրինակել տողերը: Խնդրում եմ դրանք փոխեք ձեր կարիքի:


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

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 ներքևում
Տեսակավորել մեկնաբանությունները ըստ
մեկնաբանություններ (41)
Դեռևս գնահատականներ չկան: Եղիր առաջինը, ով կգնահատի:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Սա հիանալի աշխատեց: Ի՞նչ կավելացնեմ ձեր կոդը, որպեսզի «0» ունեցող տողերը անհետանան: Մենք սա օգտագործում ենք SKU պիտակների համար: Շնորհակալություն հիանալի լուծման համար:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ես սիրում եմ քեզ. Շնորհակալություն.
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Շնորհակալություն! 10-րդ և 11-րդ տողերը «D» ցույց է տալիս տողի վերջը, և այն կարող է անհրաժեշտ լինել փոխել ձեր տվյալների տիրույթում, որպեսզի այն աշխատի:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջու՜յն,
Ինչ-որ մեկը գիտի՞ այս VBA կոդը Google Apps-ի սկրիպտների (google sheets) վերածելու:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ես օգտագործել եմ վերևի կոդը, որը հիանալի է աշխատում, բայց տողը կպցնելուց հետո ինձ անհրաժեշտ է ևս մեկ քայլ: Ես պարզապես չեմ կարող ստիպել, որ այն ճիշտ աշխատի: Ինձ անհրաժեշտ է, որ այն տեղադրվի տողում «N» սյունակում զրո, բայց այն պահի «N» արժեքը բնօրինակ պատճենված տողում:


SubCopyData ()
― Թարմացնելով Extendoffice 20160922
Dim xRow As Long
Dim VinSertNum-ը որպես տարբերակ
xՏող = 1
Դիմում. ScreenUpdating = Սուտ է
Do while (Cells(xRow, "A") <> "")
VInSertNum = Բջիջներ (xRow, «J»)
Եթե ​​((VInSertNum > 1) Եվ IsNumeric(VInSertNum)) Ապա
Շրջանակ (Բջիջներ (xRow, «A»), Բջիջներ (xRow, «AN»)). Պատճենել
Բջիջներ (xRow, 14): Արժեք = 0, սա արեց բոլոր տողերը
Շրջանակ (Բջիջներ (xRow + 1, «A»), Բջիջներ (xRow + VInSertNum - 1, «AN»)): Ընտրեք
Բջիջներ (xRow, 14): Արժեք = 0
«Սա արեց բոլոր տողերը
Selection.Insert Shift:=xlDown
Բջիջներ (xRow, 14): Արժեք = 0, սա արեց միայն առաջին տողը
xRow = xRow + VInSertNum - 1
Բջիջներ (xRow - 1, 14): Արժեք = 0
Վերջ: Եթե
Բջիջներ (xRow - 1, 14): Արժեք = 0
xRow = xRow + 1
Բջիջներ (xRow + 1, 14): Արժեք = 0
Հանգույց
'Cells(xRow, 14): Արժեք = 0, սա տողեր չի արել
Դիմում. ScreenUpdating = Սուտ է
Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Սթիվ, կարողացա՞ք դա անել: իմ պահանջը մի տեսակ նույնն է :(
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև տղերք,
Միգուցե ստորև բերված հոդվածը կարող է օգնել ձեզ, խնդրում ենք ստուգել այն.
https://www.extendoffice.com/documents/excel/3682-excel-copy-and-insert-row-multiple-times.html
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Գիտե՞ք, թե ինչ ծածկագիր կլիներ տողը մեկ անգամ կրկնօրինակելու համար՝ հիմնված այն բանի վրա, որ եթե ասեք d բջիջը պարունակում է «Այո».
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Այսպիսով, ես օգտագործում եմ այս կոդը, բայց ուզում եմ, որ այն փնտրի ամբողջ փաստաթուղթը ոչ միայն 1-ին տողում կամ այն, ինչ նշված է xRow = 1-ով: Ես փորձում եմ տեղադրել 1:2000 միջակայքում, բայց այն չի աշխատում: Ինչպե՞ս կարող եմ նույնականացնել xRow = թերթի ցանկացած տող, որը ներառում է ստորև նշված ծածկագրում իմ կողմից նույնականացված տեղեկատվությունը:


Dim xRow As Long
Dim Value As Variant


xՏող = 1: 2000

Դիմում. ScreenUpdating = Սուտ է
Do while (Cells(xRow, "A") <> "")
Արժեք = բջիջներ (xRow, «D»)
Արժեք 2 = Բջիջներ (xRow, «A»)
Եթե ​​ոչ ((Value = «allegheny general») And IsNumeric (Value2 = G0202)) Ապա
Շրջանակ (Բջիջներ (xRow, «A»), Բջիջներ (xRow, «D»)). Պատճենել
Շրջանակ (Բջիջներ (xRow + 1, «A»), Բջիջներ (xRow + 1, «D»)): Ընտրեք
Selection.Insert Shift:=xlDown
xRow = xRow + 1
Վերջ: Եթե
xRow = xRow + 1
Հանգույց
Դիմում. ScreenUpdating = Սուտ է
Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, սա հիանալի աշխատեց: Այնուամենայնիվ, ես ունեմ 1000 գրառումով զեկույց, և կոդը դադարել է կրկնօրինակվել 480 մուտքի շուրջ: Կա՞ ինչ-որ բան, որ կարող եմ ավելացնել, որպեսզի այն ավարտի գործողությունը ամբողջ զեկույցի վրա:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, Լիա,
Ես փորձարկել եմ կոդը 2000 շարքերում, և այն լավ է աշխատում:
Կարո՞ղ եք ձեր աշխատանքային թերթիկը ուղարկել ինձ կոդը փորձարկելու համար:
Իմ էլփոստի հասցեն է skyyang@extendoffice.com
Սպասեք ձեր պատասխանին:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարեւ Ձեզ! Ես այն գործի դրեցի: Դա իմ կողմից սխալ էր, զեկույցն ուներ մի քանի դատարկ տողեր, որոնք թաքնված էին, որոնք պատճառ էին դառնում, որ սցենարը դադարի պտտվել: Այն աշխատեց իմ զեկույցի համար 8,000 տողերով: Շնորհակալություն Q
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Լիա և Սկայանգ,
Ես նման խնդիր ունեմ. սցենարը լավ է աշխատում մոտ 100 տողանոց աշխատաթերթում, բայց այն դադարում է աշխատել ավելի մեծ բանի համար: Ես ստուգել եմ դատարկ տողեր այն սյունակում, որտեղից գալիս է բազմապատկման թիվը, և չկան: Որևէ այլ պատճառ, թե ինչու սցենարը կարող է չաշխատել ավելի մեծ տվյալների հավաքածուների համար:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Շնորհակալություն դա հիանալի լուծում է իմ բոլոր անախորժությունների համար:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Այս սկրիպտը կարծես հենց այն է, ինչ ինձ անհրաժեշտ է, սակայն, երբ ես այն գործարկում եմ, ես սխալ եմ ստանում Selection տողում: Տեղադրեք Shift:=x1Down

Կա՞ն առաջարկներ, թե ինչպես դա շտկել:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն, ինձ համար չի աշխատում, ես ուզում եմ հեռացնել տառերը և թվերի կրկնօրինակը հնարավո՞ր է:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Կա՞ մոդուլը թարմացնելու միջոց՝ միայն նոր տվյալների կրկնօրինակման համար: Ես աշխատում եմ ընթացիկ փաստաթղթի վրա և չեմ ցանկանում, որ կոդը կրկնօրինակի նախկինում կրկնօրինակված տվյալները:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Կա՞ որևէ կերպ, որ մենք կարող ենք յուրաքանչյուրին կրկնվող բջիջներին ավելացնել հաջորդական նշաններ: օրինակ
KTE+0001

KTE+0002
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հաճելի՜ Շնորհակալություն. Հետաքրքիր է, կարո՞ղ է որևէ մեկը հուշել, թե ինչպես ես կներառեմ տեղեկատվության նոր սյունակ աղյուսակում (սյունակ E), որը յուրաքանչյուր պատճենված տողի համար ավելացող արժեք է, 1, 2, 3, 4 և այլն... և հետո: երբ այն հասնի X անգամ կրկնվող հաջորդ կետին, այն նորից կսկսի համարակալել 1-ից և ամեն անգամ կավելանա 1-ով:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն, ես փորձել եմ սա, բայց կա՞ միջոց՝ հաշվի առնելու, թե արդյոք կան մի քանի չափանիշներ այն տվյալների հետ, որոնք ես կրկնօրինակում եմ
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջու՜յն,

Ես ստեղծում եմ աղյուսակ՝ օգտագործելով տրված բանաձևը, բայց ունեմ սխալներ: Խնդրում եմ, կարո՞ղ է որևէ մեկը ինձ տեղեկացնել, թե որն է իմ բանաձևը:

իմ աղյուսակը AY-ից է, քանակները Կ.
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
բարև, ես փորձել եմ հարմարեցնել այս կոդը, բայց դժվարություններ եմ ունեցել:
Ես ունեմ գույքագրման իրեր: Յուրաքանչյուր տարրը երկու տող է: և ուզում եմ, որ դրանք կրկնօրինակվեն N քանակով
աղյուսակի վերևում, ես մի բջիջ ունեմ, թույլ տվեք այն անվանել A1, քանի՞ անգամ է կրկնօրինակվել: Ն
ինչ էլ որ լինի N արժեքը, ես ուզում եմ կրկնօրինակել իմ ունեցած նախնական գույքագրման տարրը (A16, A17):
Այսպիսով, պատճենված տարրը պետք է սկսվի A18-ից (և դա երկու տող է, հաջորդ կետը a20 և այլն:
Շնորհակալություն
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, կոդը հիանալի է աշխատում: Ես նաև ցանկանում էի ավելացնել +1 ամսաթվին (միայն աշխատանքային օրերին) ամեն անգամ, երբ տողը կրկնօրինակվում է:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Շատ շնորհակալություն! Սա ինձ այնքան ժամանակ խնայեց, որ ես վատնում էի իմ բոլոր տվյալների տողերը պատճենելու և տեղադրելու համար:
Երկու դանակ !!
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հիանալի կոդի կտոր!!! Շնորհակալություն!!!
Առայժմ ոչ մի մեկնաբանություն չկա
Բեռնել More
Թողեք ձեր մեկնաբանությունները
Հրապարակում որպես հյուր
×
Գնահատեք այս գրառումը.
0   Անձնավորություններ
Առաջարկվող վայրեր

Հետեւեք մեզ

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