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

Hvordan duplikeres rækker baseret på celleværdi i en kolonne?

For eksempel har jeg en række data, der indeholder en liste over tal i kolonne D, og ​​nu vil jeg duplikere hele rækkerne et antal gange baseret på de numeriske værdier i kolonne D for at få følgende resultat. Hvordan kunne jeg kopiere rækkerne flere gange baseret på celleværdierne i Excel?

doc duplikere rækker efter celle 1

Kopier rækker flere gange baseret på celleværdier med VBA-kode


pil blå højre boble Kopier rækker flere gange baseret på celleværdier med VBA-kode

For at kopiere og duplikere hele rækkerne flere gange baseret på celleværdierne, kan følgende VBA-kode hjælpe dig, gør venligst som dette:

1. Hold nede ALT + F11 nøgler til at åbne Microsoft Visual Basic til applikationer vindue.

2. Klik indsatte > Moduler, og indsæt følgende kode i Moduler Vindue.

VBA-kode: Kopier rækker flere gange baseret på celleværdi:

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. Tryk derefter på F5 nøgle til at køre denne kode, er hele rækkerne duplikeret flere gange baseret på celleværdien i kolonne D, som du har brug for.

Bemærk: I ovenstående kode, brevet A angiver startkolonnen i dit dataområde og bogstavet D er det kolonnebrev, som du vil duplikere rækkerne baseret på. Skift dem til dit behov.


De bedste Office-produktivitetsværktøjer

Kutools til Excel løser de fleste af dine problemer og øger din produktivitet med 80%

  • Genbruge: Indsæt hurtigt komplekse formler, diagrammer og alt, hvad du har brugt før; Krypter celler med adgangskode Opret postliste og send e-mails ...
  • Super formel bar (let redigere flere linjer med tekst og formel); Læsning Layout (let at læse og redigere et stort antal celler); Indsæt til filtreret rækkevidde...
  • Flet celler / rækker / kolonner uden at miste data; Split celler indhold; Kombiner duplikerede rækker / kolonner... Forhindre duplikerede celler; Sammenlign områder...
  • Vælg Duplicate eller Unique Rækker; Vælg tomme rækker (alle celler er tomme); Super Find og Fuzzy Find i mange arbejdsbøger; Tilfældig valg ...
  • Præcis kopi Flere celler uden at ændre formelreference; Auto Opret referencer til flere ark; Indsæt kugler, Afkrydsningsfelter og mere ...
  • Uddrag tekst, Tilføj tekst, Fjern efter position, Fjern mellemrum; Opret og udskriv personsøgningssubtotaler; Konverter mellem celler indhold og kommentarer...
  • Superfilter (gem og anvend filterskemaer på andre ark); Avanceret sortering efter måned / uge / dag, hyppighed og mere; Specielt filter af fed, kursiv ...
  • Kombiner arbejdsbøger og arbejdsark; Fletabeller baseret på nøglekolonner; Opdel data i flere ark; Batch Konverter xls, xlsx og PDF...
  • Mere end 300 kraftfulde funktioner. Understøtter Office / Excel 2007-2021 og 365. Understøtter alle sprog. Nem implementering i din virksomhed eller organisation. Fuld funktioner 30-dages gratis prøveperiode. 60 dages pengene tilbage garanti.
kte-fane 201905

Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere

  • Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
  • Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
  • Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!
officetab bund
Sorter kommentarer efter
Kommentarer (41)
Ingen vurderinger endnu. Vær den første til at bedømme!
Denne kommentar blev minimeret af moderatoren på webstedet
Dette fungerede perfekt. Hvad vil jeg tilføje til din kode for at få linjer med '0' til at forsvinde? Vi bruger dette til SKU-etiketter. Tak for den gode løsning!
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg elsker dig. Tak skal du have.
Denne kommentar blev minimeret af moderatoren på webstedet
Tak skal du have! linje 10 og 11 "D" angiver slutningen af ​​rækken, og dette skal muligvis ændres til dit dataområde for at få det til at fungere.
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,
Nogen der ved hot konvertere denne VBA kode til Google Apps scripts (google sheets)?
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg brugte koden ovenfor, som fungerer godt, men jeg har brug for et trin mere, efter at rækken er indsat. Jeg kan bare ikke få det til at virke ordentligt. Jeg har brug for den til at sætte nul i kolonne "N" i rækken, efter den er indsat, men behold værdien i "N" i den originale kopierede række.


Sub CopyData()
'Opdatering af Extendoffice 20160922
Dim xRow As Long
Dim VInSertNum Som Variant
x række = 1
Application.ScreenUpdating = False
Gør mens (Cells(xRow, "A") <> "")
VInSertNum = Cells(xRow, "J")
Hvis ((VInSertNum > 1) And IsNumeric(VInSertNum)) så
Område(Cells(xRow, "A"), Cells(xRow, "AN")). Kopi
' Cells(xRow, 14).Værdi = 0 dette gjorde alle rækker
Område(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "AN")).Vælg
'Cells(xRow, 14).Værdi = 0
'Dette gjorde alle rækker
Selection.Insert Shift:=xlDown
' Cells(xRow, 14).Værdi = 0 dette gjorde kun den første række
xRow = xRow + VInSertNum - 1
'Cells(xRow - 1, 14).Værdi = 0
End If
' Cells(xRow - 1, 14).Værdi = 0
xRow = xRow + 1
' Celler(xRække + 1, 14).Værdi = 0
Loop
'Cells(xRow, 14).Værdi = 0 dette gjorde ingen rækker
Application.ScreenUpdating = False
End Sub
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Steve, var du i stand til at gøre dette. mit krav er lidt det samme :(
Denne kommentar blev minimeret af moderatoren på webstedet
Hej gutter,
Måske kan nedenstående artikel hjælpe dig, tjek det venligst:
https://www.extendoffice.com/documents/excel/3682-excel-copy-and-insert-row-multiple-times.html
Denne kommentar blev minimeret af moderatoren på webstedet
Ved du hvad koden ville være for at duplikere rækken bare én gang, baseret på hvis sige celle d indeholder 'Ja' - jeg har jagtet lignende kode, men for noget der vil duplikere en række baseret på en celle der siger ja
Denne kommentar blev minimeret af moderatoren på webstedet
Så jeg bruger denne kode, men jeg vil have den til at søge i hele dokumentet, ikke kun række 1 eller hvad der nu er angivet med xRow = 1. Jeg forsøger at sætte i området 1:2000, men det virker ikke. Hvordan kan jeg identificere xRow = enhver række på arket, der indeholder de oplysninger, jeg identificerer i koden nedenfor?


Dim xRow As Long
Dim værdi som variant


xRow = 1:2000

Application.ScreenUpdating = False
Gør mens (Cells(xRow, "A") <> "")
Værdi = Cells(xRow, "D")
Værdi2 = Celler(xRow, "A")
Hvis ikke ((Værdi = "allegheny general") Og IsNumeric(Value2 = G0202)) Så
Område(Cells(xRow, "A"), Cells(xRow, "D")). Kopi
Område(Cells(xRow + 1, "A"), Cells(xRow + 1, "D")).Vælg
Selection.Insert Shift:=xlDown
xRow = xRow + 1
End If
xRow = xRow + 1
Loop
Application.ScreenUpdating = False
End Sub
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, det fungerede godt. Jeg har dog en rapport med 1000 poster, og koden stoppede med at duplikere omkring post 480. Er der noget, jeg kan tilføje, så det fuldender handlingen på hele rapporten?
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Leah,
Jeg har testet koden i 2000 rækker, og den fungerer godt.
Kan du sende dit arbejdsark til mig for at teste koden?
Min e-mailadresse er skyyang@extendoffice.com
Ser frem til dit svar!
Denne kommentar blev minimeret af moderatoren på webstedet
Hej! Jeg fik det til at virke. Det var en fejl fra min side, rapporten havde et par tomme rækker, der var skjulte, som fik scriptet til at stoppe med at loope. Det virkede for min rapport med 8,000 rækker! Tak Q
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Leah og Skyyang,
Jeg har et lignende problem - scriptet fungerer fint i et regneark med omkring 100 rækker, men det holder op med at fungere for noget større. Jeg har tjekket for tomme rækker i kolonnen, hvor multiplikationstallet kommer fra, og der ikke er nogen. Er der andre grunde til, at scriptet muligvis ikke virker for større datasæt?
Denne kommentar blev minimeret af moderatoren på webstedet
Tak! det har været en god løsning på alle mine problemer!
Denne kommentar blev minimeret af moderatoren på webstedet
Dette script ser ud til at være præcis, hvad jeg har brug for, men når jeg kører det, får jeg en fejl på linjen Selection.Insert Shift:=x1Down

Nogle forslag til hvordan jeg løser dette?
Denne kommentar blev minimeret af moderatoren på webstedet
hej, for mig virker det ikke, jeg vil fjerne bogstaver og nummerduplikat er muligt?
Denne kommentar blev minimeret af moderatoren på webstedet
Er der en måde at opdatere modulet til kun at duplikere nye data? Jeg arbejder på et igangværende dokument og ønsker ikke, at koden skal duplikere data, der tidligere er blevet duplikeret.
Denne kommentar blev minimeret af moderatoren på webstedet
er der nogen måde, vi kan tilføje til hver gentagne celle, en på hinanden følgende karakterer? eksempel
KTE+0001

KTE+0002
Denne kommentar blev minimeret af moderatoren på webstedet
Dejlig! Tak skal du have. Jeg spekulerer på, om nogen kunne give et hint om, hvordan jeg ville inkorporere en ny kolonne med information i tabellen (kolonne E), som er et antal stigende værdier for hver kopierede række, 1, 2, 3, 4 osv... og så når det kommer til det næste element, der skal duplikeres X gange, begynder det at nummerere igen fra 1 og øges med 1 hver gang.
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, jeg har prøvet dette, men er der en måde at overveje, om der er flere kriterier med de data, jeg duplikerer
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,

Jeg opretter et regneark ved hjælp af den angivne formel, men jeg har fejl. kan nogen fortælle mig, hvad min formel skal være?

mit bord er fra AY med mængderne i K.
Denne kommentar blev minimeret af moderatoren på webstedet
hej, jeg har prøvet at justere denne kode, men har problemer.
jeg har lagervarer. hvert element er to rækker. og vil have dem duplikeret N antal gange
øverst i regnearket, jeg har en celle lad os kalde det A1, jeg har hvor mange gange bliver duplikeret? N
uanset værdien N er, vil jeg duplikere den oprindelige lagervare, jeg har (A16, A17) så mange gange.
så det kopierede element skulle starte i A18 (og det er to rækker, det næste element a20 osv.
Tak
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, koden fungerer fint. Jeg ønskede også at tilføje +1 til datoen (kun hverdage) hver gang rækken duplikeres.
Denne kommentar blev minimeret af moderatoren på webstedet
Mange tak! Dette har sparet mig så meget tid, at jeg plejede at spilde at kopiere og indsætte alle mine rækker af data.
To tommelfingre op!!
Denne kommentar blev minimeret af moderatoren på webstedet
Fantastisk stykke kode!!! Tak skal du have!!!
Der er endnu ingen kommentarer her
Load More
Efterlad dine kommentarer
Sender som gæst
×
Bedøm dette indlæg:
0   Tegn
Foreslåede steder

Følg os

Copyright © 2009 - www.extendoffice.com. | Alle rettigheder forbeholdes. Drevet af ExtendOffice. | | Sitemap
Microsoft og Office-logoet er varemærker eller registrerede varemærker tilhørende Microsoft Corporation i USA og / eller andre lande.
Beskyttet af Sectigo SSL