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

Kako podvojiti vrstice na podlagi vrednosti celice v stolpcu?

Na primer, imam obseg podatkov, ki vsebuje seznam števil v stolpcu D, zdaj pa želim večkrat podvojiti celotne vrstice na podlagi številskih vrednosti v stolpcu D, da dobim naslednji rezultat. Kako lahko večkrat kopiram vrstice na podlagi vrednosti celic v Excelu?

doc podvojene vrstice po celici 1

Večkrat podvojite vrstice na podlagi vrednosti celic s kodo VBA


puščica modri desni mehurček Večkrat podvojite vrstice na podlagi vrednosti celic s kodo VBA

Če želite večkrat kopirati in podvojiti celotne vrstice na podlagi vrednosti celic, vam bo morda v pomoč naslednja koda VBA, naredite tako:

1. Držite tipko ALT + F11 tipke za odpiranje Microsoft Visual Basic za aplikacije okno.

2. Kliknite Vstavi > Moduliin prilepite naslednjo kodo v Moduli Okno.

Koda VBA: Podvoji vrstice večkrat na podlagi vrednosti celice:

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. Nato pritisnite F5 Če želite zagnati to kodo, so bile celotne vrstice večkrat podvojene glede na vrednost celice v stolpcu D, kot jo potrebujete.

Opombe: V zgornji kodi črka A označuje začetni stolpec vašega obsega podatkov in črko D je črka stolpca, na podlagi katere želite podvojiti vrstice. Prosimo, spremenite jih glede na vaše potrebe.


Najboljša orodja za pisarniško produktivnost

Kutools za Excel rešuje večino vaših težav in poveča vašo produktivnost za 80%

  • Ponovna uporaba: Hitro vstavite zapletene formule, grafikoni in vse, kar ste že uporabljali; Šifriraj celice z geslom; Ustvari poštni seznam in pošiljanje e-pošte ...
  • Vrstica Super Formula (enostavno urejanje več vrstic besedila in formule); Bralna postavitev (enostavno branje in urejanje velikega števila celic); Prilepite v filtrirani obseg...
  • Združi celice / vrstice / stolpce brez izgube podatkov; Vsebina razdeljenih celic; Združi podvojene vrstice / stolpce... prepreči podvojene celice; Primerjaj obsege...
  • Izberite Duplicate ali Unique Vrstice; Izberite prazne vrstice (vse celice so prazne); Super Find in Fuzzy Find v mnogih delovnih zvezkih; Naključna izbira ...
  • Natančna kopija Več celic brez spreminjanja sklica formule; Samodejno ustvarjanje referenc na več listov; Vstavi oznake, Potrditvena polja in še več ...
  • Izvleček besedila, Dodaj besedilo, Odstrani po položaju, Odstrani presledek; Ustvari in natisni vmesne seštevke strani Pretvarjanje med vsebino celic in komentarji...
  • Super filter (shranite in uporabite sheme filtrov za druge liste); Napredno razvrščanje glede na mesec / teden / dan, pogostost in drugo; Poseben filter s krepko, ležeče ...
  • Združite delovne zvezke in delovne liste; Spoji tabele na podlagi ključnih stolpcev; Razdelite podatke na več listov; Paketna pretvorba xls, xlsx in PDF...
  • Več kot 300 zmogljivih funkcij. Podpira Office / Excel 2007-2021 in 365. Podpira vse jezike. Enostavna uvedba v vašem podjetju ali organizaciji. 30-dnevna brezplačna preizkusna različica vseh funkcij. 60-dnevna garancija vračila denarja.
zavihek kte 201905

Kartica Office prinaša vmesnik z zavihki v Office in poenostavi vaše delo

  • Omogočite urejanje in branje z zavihki v Wordu, Excelu, PowerPointu, Publisher, Access, Visio in Project.
  • Odprite in ustvarite več dokumentov v novih zavihkih istega okna in ne v novih oknih.
  • Poveča vašo produktivnost za 50%in vsak dan zmanjša na stotine klikov miške za vas!
dno pisarniške mize
Komentarji (41)
Ocene še ni. Bodite prvi in ​​ocenite!
Ta komentar je moderator na spletnem mestu minimiziral
To je delovalo odlično. Kaj bi dodal vaši kodi, da bi vse vrstice z '0' izginile? To uporabljamo za oznake SKU. Hvala za odlično rešitev!
Ta komentar je moderator na spletnem mestu minimiziral
Ljubim te. Hvala vam.
Ta komentar je moderator na spletnem mestu minimiziral
Hvala vam! vrstici 10 in 11 "D" označujeta konec vrstice in to bo morda treba spremeniti v obseg podatkov, da bo deloval.
Ta komentar je moderator na spletnem mestu minimiziral
Hi,
Nekdo ve, da to kodo VBA hitro pretvorite v skripte Google Apps (google liste)?
Ta komentar je moderator na spletnem mestu minimiziral
Uporabil sem zgornjo kodo, ki deluje odlično, vendar potrebujem še en korak, ko je vrstica prilepljena. Enostavno ga ne morem prepričati, da pravilno deluje. Potrebujem, da postavim nič v stolpec "N" v vrstici, potem ko je prilepljena, vendar ohrani vrednost v "N" v izvirni kopirani vrstici.


Sub CopyData()
'Posodobitev Extendoffice 20160922
Dim xRow As Long
Dim VInSertNum kot različica
xVrstica = 1
Application.ScreenUpdating = Napačno
Naredi medtem (celice(xRow, "A") <> "")
VInSertNum = Celice (xRow, "J")
Če ((VInSertNum > 1) In IsNumeric(VInSertNum)) potem
Obseg(celice(xRow, "A"), Celice(xRow, "AN")).Kopiraj
' Celice(xRow, 14).Value = 0 to je naredilo vse vrstice
Obseg(celice(xRow + 1, "A"), Celice(xRow + VInSertNum - 1, "AN")).Izberi
'Celice(xRow, 14).Vrednost = 0
'to je naredilo vse vrstice
Selection.Insert Shift:=xlDown
' Celice(xRow, 14).Value = 0 to je veljalo samo za prvo vrstico
xRow = xRow + VInSertNum - 1
'Celice(xRow - 1, 14).Vrednost = 0
Konec Če
' Celice(xRow - 1, 14).Vrednost = 0
xVrstica = xVrstica + 1
' Celice(xRow + 1, 14).Vrednost = 0
Zanka
'Celice(xRow, 14).Vrednost = 0 to ni opravilo nobenih vrstic
Application.ScreenUpdating = Napačno
End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Steve, ali ti je to uspelo? moja zahteva je nekako enaka :(
Ta komentar je moderator na spletnem mestu minimiziral
Živjo družba,
Morda vam bo spodnji članek pomagal, preverite ga:
https://www.extendoffice.com/documents/excel/3682-excel-copy-and-insert-row-multiple-times.html
Ta komentar je moderator na spletnem mestu minimiziral
Ali veste, kakšna bi bila koda, če bi vrstico podvojili samo enkrat, na podlagi če recimo celica d vsebuje 'Da' - lovil sem podobno kodo, vendar za nekaj, kar bo podvojilo vrstico na podlagi celice, ki pravi da
Ta komentar je moderator na spletnem mestu minimiziral
Torej uporabljam to kodo, vendar želim, da išče po celotnem dokumentu, ne samo po vrstici 1 ali karkoli, kar je označeno z xRow = 1. Poskušam postaviti v obseg 1:2000, vendar ne deluje. Kako lahko identificiram xRow = katero koli vrstico na listu, ki vključuje informacije, ki jih identificiram v spodnji kodi?


Dim xRow As Long
Dim Value As Varianta


xVrstica = 1:2000

Application.ScreenUpdating = Napačno
Naredi medtem (celice(xRow, "A") <> "")
Vrednost = celice (xRow, "D")
Vrednost 2 = celice (xRow, "A")
Če ne ((Vrednost = "splošno allegheny") In JeNumeric(Value2 = G0202)) Potem
Obseg(celice(xRow, "A"), Celice(xRow, "D")).Kopiraj
Obseg(celice(xRow + 1, "A"), Celice(xRow + 1, "D")).Izberi
Selection.Insert Shift:=xlDown
xVrstica = xVrstica + 1
Konec Če
xVrstica = xVrstica + 1
Zanka
Application.ScreenUpdating = Napačno
End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Pozdravljeni, to je delovalo odlično. Vendar imam poročilo s 1000 vnosi in koda se je nehala podvajati okoli vnosa 480. Ali lahko kaj dodam, da dokonča dejanje na celotnem poročilu?
Ta komentar je moderator na spletnem mestu minimiziral
Živjo, Leah,
Kodo sem preizkusil v 2000 vrsticah in deluje dobro.
Ali mi lahko pošljete svoj delovni list za testiranje kode?
Moj e-poštni naslov je skyyang@extendoffice.com
Veselite se vašega odgovora!
Ta komentar je moderator na spletnem mestu minimiziral
Zdravo! Spravil sem ga v delo. Na moji strani je bila napaka, poročilo je imelo nekaj skritih praznih vrstic, zaradi katerih je skript prenehal zankati. Za moje poročilo je delovalo z 8,000 vrsticami! Hvala Q
Ta komentar je moderator na spletnem mestu minimiziral
Pozdravljena Leah in Skyyang,
Imam podobno težavo - skript deluje dobro na delovnem listu s približno 100 vrsticami, vendar preneha delovati za kaj večjega. V stolpcu, od koder prihaja število množenja, sem preveril prazne vrstice in jih ni. Ali obstajajo drugi razlogi, zakaj skript morda ne deluje za večje nabore podatkov?
Ta komentar je moderator na spletnem mestu minimiziral
Hvala! je bila odlična rešitev za vse moje težave!
Ta komentar je moderator na spletnem mestu minimiziral
Zdi se, da je ta skript točno tisto, kar potrebujem, vendar ko ga zaženem, dobim napako v vrstici Selection.Insert Shift:=x1Down

Kakšen predlog, kako to popravim?
Ta komentar je moderator na spletnem mestu minimiziral
zdravo, zame ne deluje, želim odstraniti črke in številke, je možno podvojeno?
Ta komentar je moderator na spletnem mestu minimiziral
Ali obstaja način za posodobitev modula tako, da samo podvoji nove podatke? Delam na tekočem dokumentu in ne želim, da bi koda podvojila podatke, ki so bili predhodno podvojeni.
Ta komentar je moderator na spletnem mestu minimiziral
ali lahko na kakršen koli način dodamo vsaki ponovljeni celici zaporedni znak? primer
KTE+0001

KTE+0002
Ta komentar je moderator na spletnem mestu minimiziral
Lepo! Hvala vam. Zanima me, če bi mi lahko kdo dal namig, kako bi v tabelo (stolpec E) vključil nov stolpec informacij, ki je število naraščajočih vrednosti za vsako kopirano vrstico, 1, 2, 3, 4 itd... in nato ko pride do naslednjega elementa, ki ga je treba podvojiti X-krat, bo začel ponovno številčiti od 1 in se vsakič povečevati za 1.
Ta komentar je moderator na spletnem mestu minimiziral
Živjo, to sem poskusil, toda ali obstaja način, da razmislim, ali obstaja več meril s podatki, ki jih podvajam
Ta komentar je moderator na spletnem mestu minimiziral
Hi,

ustvarjam preglednico z uporabo navedene formule, vendar imam napake. prosim, mi lahko kdo pove, kakšna bi morala biti moja formula?

moja tabela je iz AY s količinami v K.
Ta komentar je moderator na spletnem mestu minimiziral
pozdravljeni, poskušal sem prilagoditi to kodo, vendar imam težave.
imam inventarne predmete. vsak element je dve vrstici. in želite, da se podvojijo N število časa
na vrhu preglednice imam celico, naj jo imenujemo A1, kolikokrat je podvojena? N
ne glede na vrednost N, želim tolikokrat podvojiti začetni predmet inventarja, ki ga imam (A16, A17).
tako da se mora kopirani element začeti v A18 (in to sta dve vrstici, naslednji element a20 itd.
Hvala
Ta komentar je moderator na spletnem mestu minimiziral
Pozdravljeni, koda deluje odlično. Prav tako sem želel dodati +1 datumu (samo med tednom) vsakič, ko se vrstica podvoji.
Ta komentar je moderator na spletnem mestu minimiziral
Najlepša hvala! To mi je prihranilo toliko časa, da sem zapravljal s kopiranjem in lepljenjem vseh svojih vrstic podatkov.
Dva palca gor!!
Ta komentar je moderator na spletnem mestu minimiziral
Odličen kos kode!!! Hvala vam!!!
Tu še ni objavljenih komentarjev
Obremenitev Več
Pustite vaše komentarje
Objava kot gost
×
Ocenite to objavo:
0   Znaki
Predlagane lokacije

Sledi nam

Copyright © 2009 - www.extendoffice.com. | Vse pravice pridržane. Poganja ga ExtendOffice. | Kazalo
Microsoft in logotip Office sta blagovni znamki ali registrirani blagovni znamki družbe Microsoft Corporation v ZDA in / ali drugih državah.
Zaščiteno s Sectigo SSL