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

Hur dupliceras rader baserat på cellvärde i en kolumn?

Till exempel har jag en rad data som innehåller en lista med siffror i kolumn D, och nu vill jag duplicera hela raderna ett antal gånger baserat på de numeriska värdena i kolumn D för att få följande resultat. Hur kunde jag kopiera raderna flera gånger baserat på cellvärdena i Excel?

doc duplicera rader efter cell 1

Duplicera rader flera gånger baserat på cellvärden med VBA-kod


pil blå höger bubbla Duplicera rader flera gånger baserat på cellvärden med VBA-kod

För att kopiera och duplicera hela raderna flera gånger baserat på cellvärdena kan följande VBA-kod hjälpa dig, gör så här:

1. Håll ner ALT + F11 nycklar för att öppna Microsoft Visual Basic för applikationer fönster.

2. Klicka Insert > Modulernaoch klistra in följande kod i Modulerna Fönster.

VBA-kod: Duplicera rader flera gånger baserat på cellvärde:

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. Tryck sedan på F5 nyckeln för att köra den här koden har hela raderna duplicerats flera gånger baserat på cellvärdet i kolumn D som du behöver.

Anmärkningar: I ovanstående kod, bokstaven A anger startkolumnen för ditt dataområde och bokstaven D är kolumnbokstaven som du vill kopiera raderna baserat på. Ändra dem efter dina behov.


De bästa Office-produktivitetsverktygen

Kutools för Excel löser de flesta av dina problem och ökar din produktivitet med 80%

  • återanvändning: Sätt snabbt i komplexa formler, diagram och allt som du har använt tidigare; Kryptera celler med lösenord; Skapa e-postlista och skicka e-post ...
  • Super Formula Bar (enkelt redigera flera rader med text och formel); Läslayout (enkelt läsa och redigera ett stort antal celler); Klistra in i filtrerat intervall...
  • Sammanfoga celler / rader / kolumner utan att förlora data; Delat cellinnehåll; Kombinera duplicerade rader / kolumner... Förhindra duplicerade celler; Jämför intervall...
  • Välj Duplicera eller Unikt Rader; Välj tomma rader (alla celler är tomma); Super Find och Fuzzy Find i många arbetsböcker; Slumpmässigt val ...
  • Exakt kopia Flera celler utan att ändra formelreferens; Skapa referenser automatiskt till flera ark; Sätt in kulor, Kryssrutor och mer ...
  • Extrahera text, Lägg till text, ta bort efter position, Ta bort mellanslag; Skapa och skriva ut personsökningstalsatser; Konvertera mellan celler innehåll och kommentarer...
  • Superfilter (spara och tillämpa filterscheman på andra ark); Avancerad sortering efter månad / vecka / dag, frekvens och mer; Specialfilter av fet, kursiv ...
  • Kombinera arbetsböcker och arbetsblad; Sammanfoga tabeller baserat på nyckelkolumner; Dela data i flera ark; Batchkonvertera xls, xlsx och PDF...
  • Mer än 300 kraftfulla funktioner. Stöder Office / Excel 2007-2021 och 365. Stöder alla språk. Enkel implementering i ditt företag eller organisation. Fullständiga funktioner 30 dagars gratis provperiod. 60 dagars pengarna tillbaka-garanti.
kte-flik 201905

Fliken Office ger ett flikgränssnitt till Office och gör ditt arbete mycket enklare

  • Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
  • Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
  • Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje dag!
officetab botten
Sortera kommentarer efter
Kommentarer (41)
Inga betyg än. Bli först med att betygsätta!
Denna kommentar minimerades av moderatoren på webbplatsen
Detta fungerade perfekt. Vad skulle jag lägga till i din kod för att få alla rader med '0' att försvinna? Vi använder detta för SKU-etiketter. Tack för den bra lösningen!
Denna kommentar minimerades av moderatoren på webbplatsen
Jag älskar dig. Tack.
Denna kommentar minimerades av moderatoren på webbplatsen
Tack! raderna 10 och 11 "D" indikerar slutet på raden och detta kan behöva ändras till ditt dataområde för att det ska fungera.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej,
Någon som vet hot konvertera denna VBA-kod till Google Apps-skript (google sheets)?
Denna kommentar minimerades av moderatoren på webbplatsen
Jag använde koden ovan som fungerar utmärkt men jag behöver ett steg till efter att raden har klistrats in. Jag kan bara inte få det att fungera ordentligt. Jag behöver den för att sätta noll i kolumn "N" i raden efter att den har klistrats in men behåll värdet i "N" i den ursprungliga kopierade raden.


Sub CopyData()
'Uppdatering av Extendoffice 20160922
Dim xRow As Long
Dim VInSertNum Som variant
xRad = 1
Application.ScreenUpdating = False
Gör medan (Cells(xRow, "A") <> "")
VInSertNum = Cells(xRow, "J")
Om ((VInSertNum > 1) And IsNumeric(VInSertNum)) Då
Område(Cells(xRow, "A"), Cells(xRow, "AN")). Kopiera
' Cells(xRow, 14).Value = 0 detta gjorde alla rader
Område(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "AN")).Välj
'Cells(xRow, 14).Värde = 0
'det här gjorde alla rader
Selection.Insert Shift:=xlDown
' Cells(xRow, 14).Value = 0 detta gjorde endast den första raden
xRow = xRow + VInSertNum - 1
'Cells(xRow - 1, 14).Värde = 0
End If
' Cells(xRow - 1, 14).Värde = 0
xRow = xRow + 1
' Cells(xRow + 1, 14).Värde = 0
loop
'Cells(xRow, 14).Value = 0 detta gjorde inga rader
Application.ScreenUpdating = False
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Steve, kunde du göra det här. mina krav är ungefär samma :(
Denna kommentar minimerades av moderatoren på webbplatsen
Hej grabbar,
Kanske kan artikeln nedan hjälpa dig, kolla in den:
https://www.extendoffice.com/documents/excel/3682-excel-copy-and-insert-row-multiple-times.html
Denna kommentar minimerades av moderatoren på webbplatsen
Vet du vad koden skulle vara för att duplicera raden bara en gång, baserat på om säg att cell d innehåller "Ja" - jag har jagat liknande kod men för något som kommer att duplicera en rad baserat på en cell som säger ja
Denna kommentar minimerades av moderatoren på webbplatsen
Så jag använder den här koden, men jag vill att den ska söka igenom hela dokumentet, inte bara rad 1 eller vad som anges med xRow = 1. Jag försöker lägga in intervallet 1:2000 men det fungerar inte. Hur kan jag identifiera xRow = valfri rad på arket som innehåller informationen jag identifierar i koden nedan?


Dim xRow As Long
Dimvärde som variant


xRow = 1:2000

Application.ScreenUpdating = False
Gör medan (Cells(xRow, "A") <> "")
Värde = Cells(xRow, "D")
Value2 = Cells(xRow, "A")
Om inte ((Value = "allmänt allmänt") Och IsNumeric(Value2 = G0202)) Då
Område(Cells(xRow, "A"), Cells(xRow, "D")). Kopiera
Område(Cells(xRow + 1, "A"), Cells(xRow + 1, "D")).Välj
Selection.Insert Shift:=xlDown
xRow = xRow + 1
End If
xRow = xRow + 1
loop
Application.ScreenUpdating = False
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, det här fungerade utmärkt. Däremot har jag en rapport med 1000 poster och koden slutade dupliceras runt post 480. Finns det något jag kan lägga till så att det slutför åtgärden på hela rapporten?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Leah,
Jag har testat koden i 2000 rader, och den fungerar bra.
Kan du skicka ditt arbetsblad till mig för att testa koden?
Min e-postadress är skyyang@extendoffice.com
Ser fram emot ditt svar!
Denna kommentar minimerades av moderatoren på webbplatsen
Hallå! Jag fick det att fungera. Det var ett fel från min sida, rapporten hade några tomma rader som var gömda som fick skriptet att sluta loopa. Det fungerade för min rapport med 8,000 XNUMX rader! Tack Q
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Leah och Skyyang,
Jag har ett liknande problem - skriptet fungerar bra i ett kalkylblad med cirka 100 rader men det slutar fungera för något större. Jag har kollat ​​efter tomma rader i kolumnen där multiplikationstalet kommer ifrån och det inte finns några. Några andra anledningar till att skriptet kanske inte fungerar för större datamängder?
Denna kommentar minimerades av moderatoren på webbplatsen
Tack! det har varit en bra lösning för alla mina problem!
Denna kommentar minimerades av moderatoren på webbplatsen
Det här skriptet verkar vara precis vad jag behöver, men när jag kör det får jag ett felmeddelande på raden Selection.Insert Shift:=x1Down

Några förslag på hur jag fixar detta?
Denna kommentar minimerades av moderatoren på webbplatsen
hej, för mig fungerar inte, jag vill ta bort bokstäver och sifferduplicering är möjlig?
Denna kommentar minimerades av moderatoren på webbplatsen
Finns det något sätt att uppdatera modulen för att bara duplicera ny data? Jag arbetar med ett pågående dokument och vill inte att koden ska duplicera data som tidigare har duplicerats.
Denna kommentar minimerades av moderatoren på webbplatsen
finns det något sätt vi kan lägga till en rad tecken i varje upprepad cell? exempel
KTE+0001

KTE+0002
Denna kommentar minimerades av moderatoren på webbplatsen
Härlig! Tack. Jag undrar om någon skulle kunna ge ett tips om hur jag skulle infoga en ny kolumn med information i tabellen (kolumn E) som är ett antal ökande värden för varje kopierad rad, 1, 2, 3, 4 osv... och sedan när den kommer till nästa objekt som ska dupliceras X gånger, börjar den numreras igen från 1 och ökar med 1 varje gång.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, jag har provat detta men finns det ett sätt att överväga om det finns flera kriterier med uppgifterna jag duplicerar
Denna kommentar minimerades av moderatoren på webbplatsen
Hej,

Jag skapar ett kalkylblad med den angivna formeln men jag har fel. snälla kan någon berätta för mig vad min formel ska vara?

mitt bord är från AY med kvantiteterna i K.
Denna kommentar minimerades av moderatoren på webbplatsen
hej, jag har försökt justera den här koden men har problem.
jag har inventeringsartiklar. varje objekt är två rader. och vill att de ska dupliceras N antal gånger
längst upp i kalkylarket, jag har en cell kan vi kalla den A1, jag har hur många gånger som dupliceras? N
oavsett värdet N är, vill jag duplicera den ursprungliga inventeringsartikeln jag har (A16, A17) så många gånger.
så det kopierade objektet ska börja i A18 (och det är två rader, nästa objekt a20 osv.
Tack
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, koden fungerar utmärkt. Jag ville också lägga till +1 till datumet (endast vardagar) varje gång raden dupliceras.
Denna kommentar minimerades av moderatoren på webbplatsen
Tack så mycket! Detta har sparat mig så mycket tid att jag brukade slösa bort att kopiera och klistra in alla mina rader med data.
Två tummar upp!!
Denna kommentar minimerades av moderatoren på webbplatsen
Fantastisk kodbit!!! Tack!!!
Det finns inga kommentarer här ännu
Ladda fler
Lämna dina kommentarer
Postar som gäst
×
Betygsätt detta inlägg:
0   Tecken
Föreslagna platser

Följ oss

Copyright © 2009 - www.extendoffice.com. | Alla rättigheter förbehållna. Drivs av ExtendOffice. | | Sitemap
Microsoft och Office-logotypen är varumärken eller registrerade varumärken som tillhör Microsoft Corporation i USA och / eller andra länder.
Skyddad av Sectigo SSL