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

Cum se duplică rândurile pe baza valorii celulei dintr-o coloană?

De exemplu, am o gamă de date care conține o listă de numere din coloana D și acum, doresc să duplic toate rândurile de mai multe ori pe baza valorilor numerice din coloana D pentru a obține următorul rezultat. Cum aș putea copia rândurile de mai multe ori pe baza valorilor celulei din Excel?

doc rânduri duplicate după celula 1

Duplicați rânduri de mai multe ori pe baza valorilor celulei cu cod VBA


săgeată albastru dreapta balon Duplicați rânduri de mai multe ori pe baza valorilor celulei cu cod VBA

Pentru a copia și duplica rândurile întregi de mai multe ori pe baza valorilor celulei, următorul cod VBA vă poate ajuta, vă rugăm să faceți acest lucru:

1. Țineți apăsat butonul ALT + F11 tastele pentru a deschide Microsoft Visual Basic pentru aplicații fereastră.

2. Clic Insera > Moduleși lipiți următorul cod în Module Fereastră.

Cod VBA: Duplicați rânduri de mai multe ori pe baza valorii celulei:

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. Apoi apăsați F5 cheie pentru a rula acest cod, întregul rând a fost duplicat de mai multe ori pe baza valorii celulei din coloana D după cum aveți nevoie.

notițe: În codul de mai sus, litera A indică coloana de început a intervalului de date și litera D este litera coloanei pe care doriți să copiați rândurile pe baza căreia. Vă rugăm să le schimbați în funcție de nevoile dvs.


Cele mai bune instrumente de productivitate Office

Kutools pentru Excel vă rezolvă majoritatea problemelor și vă crește productivitatea cu 80%

  • reutilizarea: Introduceți rapid formule complexe, diagrame și orice ai folosit anterior; Criptați celulele cu parola; Creați o listă de corespondență și trimiteți e-mailuri ...
  • Super Formula Bar (editați cu ușurință mai multe linii de text și formulă); Layout de citire (citiți și editați cu ușurință un număr mare de celule); Lipiți la interval filtrat...
  • Merge celule / rânduri / coloane fără a pierde date; Conținut de celule divizate; Combinați rânduri / coloane duplicate... Prevenirea celulelor duplicate; Comparați gamele...
  • Selectați Duplicat sau Unic Rânduri; Selectați Rânduri goale (toate celulele sunt goale); Super Find și Fuzzy Find în multe cărți de lucru; Selectare aleatorie ...
  • Copie exactă Mai multe celule fără modificarea referinței formulelor; Creați automat referințe la foi multiple; Introduceți gloanțe, Casete de selectare și multe altele ...
  • Extrageți textul, Adăugați text, eliminați după poziție, Eliminați spațiul; Creați și imprimați subtotaluri de paginare; Convertiți conținutul dintre celule și comentarii...
  • Super Filtru (salvați și aplicați scheme de filtrare altor foi); Sortare avansată după lună / săptămână / zi, frecvență și multe altele; Filtru special cu bold, italic ...
  • Combinați cărți de lucru și foi de lucru; Merge Tables pe baza coloanelor cheie; Împărțiți datele în mai multe foi; Conversia în loturi xls, xlsx și PDF...
  • Peste 300 de funcții puternice. Suportă Office / Excel 2007-2021 și 365. Acceptă toate limbile. Implementare ușoară în întreprinderea sau organizația dvs. Funcții complete Probă gratuită de 30 de zile. Garanție de returnare a banilor de 60 de zile.
fila kte 201905

Fila Office aduce interfața cu file în Office și vă face munca mult mai ușoară

  • Activați editarea și citirea cu file în Word, Excel, PowerPoint, Publisher, Access, Visio și Project.
  • Deschideți și creați mai multe documente în filele noi ale aceleiași ferestre, mai degrabă decât în ​​ferestrele noi.
  • Vă crește productivitatea cu 50% și reduce sute de clicuri de mouse pentru dvs. în fiecare zi!
fundul officetab
Comentarii (41)
Încă nu există evaluări. Fii primul care evaluează!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Acest lucru a funcționat perfect. Ce aș adăuga la codul tău pentru a face orice rând cu „0” să dispară? Folosim acest lucru pentru etichetele SKU. Mulțumesc pentru soluția excelentă!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Te iubesc. Mulțumesc.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Mulțumesc! liniile 10 și 11 „D” indică sfârșitul rândului, iar acesta poate fi necesar să fie modificat în intervalul de date pentru ca acesta să funcționeze.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună,
Știe cineva să convertești acest cod VBA în scripturi Google Apps (foi Google)?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Am folosit codul de mai sus, care funcționează grozav, dar am nevoie de încă un pas după ce rândul este lipit. Pur și simplu nu pot să-l fac să funcționeze corect. Am nevoie să pun zero în coloana „N” în rând după ce este lipit, dar păstrează valoarea în „N” în rândul original copiat.


Sub CopyData()
'Actualizare de Extendoffice 20160922
Dim xRow As Long
Dim VInSertNum ca variantă
xRând = 1
Application.ScreenUpdating = Fals
Do While (Cells(xRow, "A") <> "")
VInSertNum = Cells(xRow, "J")
Dacă ((VInSertNum > 1) și IsNumeric(VInSertNum)) atunci
Interval(Celele(xRow, „A”), Cells(xRow, „AN”).Copy
' Cells(xRow, 14).Value = 0 aceasta a făcut toate rândurile
Interval(Celele(xRow + 1, „A”), Cells(xRow + VInSertNum - 1, „AN”)).Selectați
„Cells(xRow, 14).Valoare = 0
„Asta a făcut toate rândurile
Selection.Insert Shift:=xlDown
' Cells(xRow, 14).Value = 0 aceasta a făcut doar primul rând
xRow = xRow + VInSertNum - 1
„Celele(xRow - 1, 14).Valoare = 0
Final, dacă
' Celule (xRow - 1, 14).Valoare = 0
xRow = xRow + 1
' Celule (xRow + 1, 14).Valoare = 0
Buclă
„Cells(xRow, 14).Value = 0 aceasta nu a avut rânduri
Application.ScreenUpdating = Fals
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut Steve, ai reușit să faci asta. cerinta mea este cam aceeasi :(
Acest comentariu a fost redus la minimum de moderatorul de pe site
Buna baieti,
Poate că articolul de mai jos vă poate ajuta, vă rugăm să îl verificați:
https://www.extendoffice.com/documents/excel/3682-excel-copy-and-insert-row-multiple-times.html
Acest comentariu a fost redus la minimum de moderatorul de pe site
Știți care ar fi codul pentru a duplica rândul o singură dată, pe baza dacă celula d conține „Da” - Am urmărit un cod similar, dar pentru ceva care va duplica un rând pe baza unei celule care spune da
Acest comentariu a fost redus la minimum de moderatorul de pe site
Deci folosesc acest cod, dar vreau să caute în întregul document nu doar rândul 1 sau orice este indicat de xRow = 1. Încerc să pun în intervalul 1:2000, dar nu funcționează. Cum pot identifica xRow = orice rând de pe foaie care include informațiile pe care le identific în codul de mai jos?


Dim xRow As Long
Dim Value As Variant


xRând = 1: 2000

Application.ScreenUpdating = Fals
Do While (Cells(xRow, "A") <> "")
Valoare = Cells(xRow, "D")
Valoarea2 = Cells(xRow, "A")
Dacă nu ((Valoare = „allegheny general”) și IsNumeric(Value2 = G0202)) Atunci
Interval(Celele(xRow, „A”), Cells(xRow, „D”)).
Interval(Celele(xRând + 1, „A”), Celule(xRând + 1, „D”)).Selectați
Selection.Insert Shift:=xlDown
xRow = xRow + 1
Final, dacă
xRow = xRow + 1
Buclă
Application.ScreenUpdating = Fals
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, a funcționat excelent. Totuși, am un raport cu 1000 de intrări și codul a încetat să se dubleze în jurul intrării 480. Există ceva ce pot adăuga, astfel încât să finalizeze acțiunea asupra întregului raport?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, Leah,
Am testat codul pe 2000 de rânduri și funcționează bine.
Îmi puteți trimite foaia de lucru pentru a testa codul?
Adresa mea de e-mail este skyyang@extendoffice.com
Așteptați cu nerăbdare răspunsul dvs.!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Buna! L-am pus să lucreze. A fost o eroare din partea mea, raportul avea câteva rânduri goale care erau ascunse care făceau ca scriptul să se oprească. A funcționat pentru raportul meu cu 8,000 de rânduri! Mulțumesc Q
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună Leah și Skyyang,
Am o problemă similară - scriptul funcționează bine într-o foaie de lucru de aproximativ 100 de rânduri, dar nu mai funcționează pentru ceva mai mare. Am verificat rândurile goale în coloana de la care provine numărul de înmulțire și nu există. Alte motive pentru care scriptul ar putea să nu funcționeze pentru seturi de date mai mari?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Mulțumiri! a fost o soluție grozavă pentru toate necazurile mele!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Acest script pare să fie exact ceea ce am nevoie, totuși, când îl rulez, primesc o eroare pe linia Selection.Insert Shift:=x1Down

Ceva sugestii despre cum repar asta?
Acest comentariu a fost redus la minimum de moderatorul de pe site
salut, pentru mine nu funcționează, vreau să elimin literele și numărul duplicat este posibil?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Există o modalitate de a actualiza modulul pentru a duplica doar date noi? Lucrez la un document în curs de desfășurare și nu vreau ca codul să dubleze datele care au fost duplicate anterior.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Există vreo modalitate prin care putem adăuga la fiecare celulă repetat, un caracter consecutiv? exemplu
KTE+0001

KTE+0002
Acest comentariu a fost redus la minimum de moderatorul de pe site
Minunat! Mulțumesc. Mă întreb dacă cineva ar putea oferi un indiciu despre cum aș încorpora o nouă coloană de informații în tabel (coloana E), care este un număr de valoare incrementală pentru fiecare rând copiat, 1, 2, 3, 4 etc... și apoi când ajunge la următorul articol care urmează să fie duplicat de X ori, va începe numerotarea din nou de la 1 și va crește cu 1 de fiecare dată.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, am încercat acest lucru, dar există o modalitate de a lua în considerare dacă există mai multe criterii cu datele pe care le dublez
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună,

Eu creez o foaie de calcul folosind formula furnizată, dar am erori. va rog, imi poate spune cineva care ar trebui sa fie formula mea?

Tabelul meu este din AY cu cantitățile în K.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună ziua, am încercat să ajustez acest cod, dar am avut dificultăți.
am articole de inventar. fiecare articol este de două rânduri.și le doresc duplicat N număr de timp
în partea de sus a foii de calcul, am o celulă, să o numim A1, am de câte ori sunt duplicate? N
Oricare ar fi valoarea N, vreau să dublez articolul inițial de inventar pe care îl am (A16, A17) de atâtea ori.
deci articolul copiat ar trebui să înceapă în A18 (și sunt două rânduri, următorul articol a20 etc.
mulțumesc
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, codul funcționează excelent. De asemenea, am vrut să adaug +1 la dată (numai în zilele săptămânii) de fiecare dată când rândul este duplicat.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Mulțumesc foarte mult! Acest lucru mi-a economisit atât de mult timp încât obișnuiam să pierd copierea și lipirea tuturor rândurilor mele de date.
Doua degete sus!!
Acest comentariu a fost redus la minimum de moderatorul de pe site
O bucată grozavă de cod!!! Mulțumesc!!!
Nu există comentarii postate aici încă
Încărcați mai
Lăsa comentarii
Postare ca invitat
×
Evaluează această postare:
0   Caractere
Locații sugerate

Urmărește-ne

Copyright © 2009 - www.extendoffice.com. | Toate drepturile rezervate. Cu sprijinul ExtendOffice. | Harta site-ului
Microsoft și sigla Office sunt mărci comerciale sau mărci comerciale înregistrate ale Microsoft Corporation în Statele Unite și / sau în alte țări.
Protejat de Sectigo SSL