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

Hogyan illeszthet be meghatározott számú sort rögzített időközönként az Excelbe?

Az Excel munkalapon egy üres sort szúrhat be a meglévő sorok közé a Beszúrás funkció használatával. De ha nagy az adattartománya, és minden harmadik második sor után két üres sort kell beillesztenie, hogyan tudná ezt a munkát gyorsan és kényelmesen befejezni?


Helyezzen be meghatározott számú üres sort az adattartományba, rögzített időközönként, VBA kóddal

A következő VBA-kód segíthet egy adott számú sor beszúrásában a meglévő adatok minden n-edik sora után. Kérjük, tegye a következőket:

1. Tartsa lenyomva a ALT + F11 kulcsokat az Excelben, és megnyitja a Microsoft Visual Basic for Applications ablak.

2. Kattints betétlap > Modulok, és illessze be a következő kódot a Modul ablak.

VBA kód: Helyezzen be meghatározott számú sort az adatokba, rögzített időközönként

Sub InsertRowsAtIntervals()
'Updateby Extendoffice
Dim Rng As Range
Dim xInterval As Integer
Dim xRows As Integer
Dim xRowsCount As Integer
Dim xNum1 As Integer
Dim xNum2 As Integer
Dim WorkRng As Range
Dim xWs As Worksheet
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
xRowsCount = WorkRng.Rows.Count
xInterval = Application.InputBox("Enter row interval. ", xTitleId, 1, Type:=1)
xRows = Application.InputBox("How many rows to insert at each interval? ", xTitleId, 1, Type:=1)
xNum1 = WorkRng.Row + xInterval
xNum2 = xRows + xInterval
Set xWs = WorkRng.Parent
For i = 1 To Int(xRowsCount / xInterval)
    xWs.Range(xWs.Cells(xNum1, WorkRng.Column), xWs.Cells(xNum1 + xRows - 1, WorkRng.Column)).Select
    Application.Selection.EntireRow.Insert
    xNum1 = xNum1 + xNum2
Next
End Sub

3. A kód beillesztése után nyomja meg a gombot F5 kulcs a kód futtatásához, megjelenik egy felszólító mező, amely emlékezteti Önt arra az adattartomány kiválasztására, amelyre üres sorokat szeretne beilleszteni, lásd a képernyőképet:

4. Kattints OK gombra, megjelenik egy újabb prompt doboz, kérjük, adja meg a sorközök számát, lásd a képernyőképet:

5. Kattintson a gombra OK gombra, a következő felbukkanó prompt mezőbe írja be a beilleszteni kívánt üres sorok számát, lásd a képernyőképet:

6. Ezután kattintson OK, és az üres sorokat rendszeres időközönként illesztették be a meglévő adatokba, lásd a képernyőképeket:


Helyezzen be egy bizonyos számú üres sort az adattartományba a VBA kóddal ellátott cellaértékek alapján

Előfordulhat, hogy a cellák értékeinek listája alapján be kell illesztenie az üres sorokat, ebben az esetben az alábbi VBA-kód kedvezhet nekünk, kérjük, tegye a következőket:

1. Tartsa lenyomva a ALT + F11 kulcsokat az Excelben, és megnyitja a Microsoft Visual Basic for Applications ablak.

2. Kattints betétlap > Modulok, és illessze be a következő kódot a Modul ablak.

VBA kód: Helyezzen be egy bizonyos számú üres sort a számok listája alapján:

Sub Insertblankrowsbynumbers ()
'UpdatebyExtendoffice
Dim xRg As Range
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Select the spefic number column to use(single column):", "Kutools For Excel", xAddress, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
xLastRow = xRg(1).End(xlDown).Row
xFstRow = xRg.Row
xCol = xRg.Column
xCount = xRg.Count
Set xRg = xRg(1)
For I = xLastRow To xFstRow Step -1
xNum = Cells(I, xCol)
If IsNumeric(xNum) And xNum > 0 Then
Rows(I + 1).Resize(xNum).Insert
xCount = xCount + xNum
End If
Next
xRg.Resize(xCount, 1).Select
Application.ScreenUpdating = True
End Sub

3. A kód beillesztése után nyomja meg a gombot F5 kulcs a kód futtatásához, a felbukkanó párbeszédpanelen válassza ki a számok listáját, amelyek alapján üres sorokat szeretne beszúrni, lásd a képernyőképet:

4. Ezután kattints a gombra OK, és megkapja a kívánt eredményeket a következő képernyőképek segítségével:


Helyezzen be meghatározott számú üres sort az adattartományba, rögzített időközönként, hasznos funkcióval

Ha nem ismeri a fenti VBA kódot, Kutools az Excel számára is segíthet, annak Üres sorok és oszlopok beszúrása funkció segítségével meghatározott számú sort vagy oszlopot lehet beilleszteni a meglévő adatokba, rögzített időközönként, gyorsan és egyszerűen.

Jegyzet:Ennek alkalmazásához Üres sorok és oszlopok beszúrása , először is le kell töltenie a Kutools az Excel számára, majd gyorsan és egyszerűen alkalmazza a funkciót.

Telepítése után Kutools az Excel számára, kérjük, tegye a következőket:

1. Válassza ki azt az adattartományt, amelybe időközönként üres sorokat szeretne beilleszteni.

2. Kattints Kutools > betétlap > Üres sorok és oszlopok beszúrása, lásd a képernyőképet:

3. Az Helyezze be az üres sort és oszlopokat párbeszédpanelen válassza a lehetőséget Üres sorok opció a Beszúrás típusa, majd adja meg a használni kívánt intervallum és üres sorok számát a következő képernyőképen:

4. Ezután kattintson OK gombra, és az üres sorokat meghatározott időközönként illesztette be a kiválasztott tartományba, az alábbi képernyőkép szerint:

Töltse le és ingyenes próbaverziót Kutools for Excel Now!


Sorok másolása és beszúrása többször, VBA kóddal ellátott számok alapján

Tegyük fel, hogy van akkori tartománya, és most minden sort meg akar másolni, és többször beilleszteni a következő sorba a számok listája alapján, az alábbi képernyőképek alapján. Hogyan oldhatná meg ezt a feladatot az Excel munkalapon?

Ennek a munkának a kezeléséhez bevezetek egy hasznos kódot az Ön számára, kérjük, tegye a következőket:

1. Tartsa lenyomva a ALT + F11 kulcsokat az Excelben, és megnyitja a Microsoft Visual Basic for Applications ablak.

2. Kattints betétlap > Modulok, és illessze be a következő kódot a Modul ablak.

VBA-kód: Sorok másolása és beszúrása többször is meghatározott számok alapján:

Sub CopyRows()
'UpdatebyExtendoffice
Dim xRg As Range
Dim xCRg As Range
Dim xFNum As Integer
Dim xRN As Integer
On Error Resume Next
SelectRange:
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Select the list of numbers to copy the rows based on: ", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub

If xRg.Columns.Count > 1 Then
MsgBox "Please select single column!"
GoTo SelectRange
End If
Application.ScreenUpdating = False
For xFNum = xRg.Count To 1 Step -1
Set xCRg = xRg.Item(xFNum)
xRN = CInt(xCRg.Value)
With Rows(xCRg.Row)
.Copy
.Resize(xRN).Insert
End With
Next
Application.ScreenUpdating = True
End Sub

3. A kód beillesztése után nyomja meg a gombot F5 kulcs a kód futtatásához, a felbukkanó párbeszédpanelen válassza ki a másolni kívánt számok listáját, és helyezze be az adatsorokat, lásd a képernyőképet:

4. Ezután kattints a gombra OK gombra, és a sorok számát másolja és illessze be az egyes eredeti sorok alá, lásd a képernyőképeket:


Másoljon és szúrjon be sorokat többször, konkrét számok alapján, csodálatos funkcióval

Ha van Kutools az Excel számára, Annak Sorok / oszlopok duplikálása a cellaérték alapján funkcióval gyorsan és egyszerűen beillesztheti a sorokat vagy oszlopokat a számlista alapján.

Jegyzet:Ennek alkalmazásához Sorok / oszlopok duplikálása a cellaérték alapján, először is le kell töltenie a Kutools az Excel számára, majd gyorsan és egyszerűen alkalmazza a funkciót.

Telepítése után Kutools az Excel számára, kérjük, tegye a következőket:

1. Kattints Kutools > betétlap > Sorok / oszlopok duplikálása a cellaérték alapján, lásd a képernyőképet:

2. Az Sorok és oszlopok másolása és beszúrása párbeszédpanelen válassza ki Sorok másolása és beszúrása lehetőség a típus szakasz, majd válassza ki a másolni kívánt adattartományt, majd adja meg az értékek listáját, amelyek alapján sorokat szeretne másolni, lásd a képernyőképet:

4. Ezután kattints a gombra Ok or alkalmaz gombra kattintva a következő eredményt kapja:

Töltse le és ingyenes próbaverziót Kutools for Excel Now!

Relatívabb cikkek:

  • Másolja és illessze be a sort többször, vagy másolja le az X sort
  • A mindennapi munkája során megpróbált már másolni egy sort vagy minden sort, majd többször beilleszteni az aktuális adatsor alá egy munkalapba? Például van egy cellatartományom, most szeretnék minden sort másolni, és háromszor beilleszteni a következő sorba, az alábbi képernyőkép szerint. Hogyan tudta kezelni ezt a munkát az Excelben?
  • Üres sorok beszúrása, ha az érték megváltozik az Excelben
  • Tegyük fel, hogy van egy adattartománya, és most üres sorokat szeretne beilleszteni az adatok közé, amikor az érték megváltozik, hogy a szekvenciális ugyanazokat az értékeket egy oszlopban különíthesse el, a következő képernyőképek szerint. Ebben a cikkben néhány trükkről fogok beszélni, amelyek segítségével megoldhatja ezt a problémát.
  • Sorok másolása több munkalapról a kritériumok alapján egy új munkalapba
  • Tegyük fel, hogy van egy munkafüzete, amely három munkalapot tartalmaz, amelyek formázása megegyezik az alábbi képernyőképen látható ábrával. Most át akarja másolni ezekből a munkalapokból az összes sort, amely C oszlop tartalmazza a „Befejezett” szöveget egy új munkalapba. Hogyan oldhatná meg ezt a problémát gyorsan és egyszerűen anélkül, hogy manuálisan másolná és beillesztené őket?

A legjobb irodai termelékenységi eszközök

A Kutools for Excel megoldja a legtöbb problémát, és 80% -kal növeli a termelékenységet

  • újrafelhasználás: Gyorsan helyezze be összetett képletek, diagramok és bármi, amit korábban használt; Cellák titkosítása jelszóval; Levelezőlista létrehozása és e-maileket küldeni ...
  • Szuper Formula Bár (könnyedén szerkeszthet több szöveget és képletet); Olvasás elrendezés (könnyen olvasható és szerkeszthető nagyszámú cella); Beillesztés a Szűrt tartományba...
  • Cellák / sorok / oszlopok egyesítése az adatok elvesztése nélkül; Osztott cellák tartalma; Kombinálja a duplikált sorokat / oszlopokat... megakadályozza az ismétlődő cellákat; Hasonlítsa össze a tartományokat...
  • Válassza a Másolat vagy az Egyedi lehetőséget Sorok; Válassza az Üres sorok lehetőséget (az összes cella üres); Super Find és Fuzzy Find sok munkafüzetben; Véletlenszerű kiválasztás ...
  • Pontos másolás Több cella a képletreferencia megváltoztatása nélkül; Automatikus referenciák létrehozása több lapra; Helyezze be a golyókat, Jelölőnégyzetek és még sok más ...
  • Kivonat szöveg, Szöveg hozzáadása, Eltávolítás pozíció szerint, Hely eltávolítása; Hozz létre és nyomtasson személyhívó részösszegeket; Konvertálás a cellatartalom és a megjegyzések között...
  • Szuper szűrő (mentse el és alkalmazza a szűrősémákat más lapokra); Haladó rendezés hónap / hét / nap, gyakoriság és egyebek szerint; Speciális szűrő félkövér, dőlt betűvel ...
  • Kombinálja a munkafüzeteket és a munkalapokat; Táblázatok egyesítése kulcsoszlopok alapján; Az adatok felosztása több lapra; Kötegelt konvertálás xls, xlsx és PDF...
  • Több mint 300 hatékony funkció. Támogatja az Office / Excel 2007-2021 és 365 verziókat. Minden nyelvet támogat. Könnyű üzembe helyezés vállalatában vagy szervezetében. Teljes funkciók 30 napos ingyenes próbaverzió. 60 napos pénzvisszafizetési garancia.
kte lap 201905

Az Office fül a füles felületet hozza az Office-ba, és sokkal könnyebbé teszi a munkáját

  • Füles szerkesztés és olvasás engedélyezése Wordben, Excelben és PowerPointban, Publisher, Access, Visio és Project.
  • Több dokumentum megnyitása és létrehozása ugyanazon ablak új lapjain, mint új ablakokban.
  • 50% -kal növeli a termelékenységet, és naponta több száz kattintással csökkenti az egér kattintását!
officetab alja
A megjegyzések rendezése szerint
Hozzászólások (39)
Az 5-t az 5-ből kiértékelte · 2 értékelés
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia! Az Ön kódját használom (lent), kérem, mondja meg, hogyan tölthetem ki ezeket a sorokat egyéni szöveggel. A kódoddal három sort írtam be, tökéletesen működött, de most be kell írnom a következőt: Row1 = Dátum Row2.= Hely Row3 = Telefonszám Előre is köszönöm... "Sub InsertRowsAtIntervals() 'Updateby20150707 Dim Rng As Range Dim xInterval As Integer Dim xRows As Integer Dim xRowsCount As Integer Dim xNum1 As Integer Dim xNum2 As Integer Dim WorkRng As Range Dim xWs As Worksheet xTitleId = "KutoolsforExcel" Set Application WorkputB", =Alkalmazás Set.Indd. , WorkRng.Address, Type:=8) xRowsCount = WorkRng.Rows.Count xInterval = Application.InputBox("Adja meg a sor intervallumát. ", xTitleId, 1, Type:=1) xRows = Application.InputBox("Hány sort kell beszúrja az egyes intervallumokhoz? ", xTitleId, 1, Type:=1) xNum1 = WorkRng.Row + xInterval xNum2 = xRows + xInterval Set xWs = WorkRng.Parent For i = 1 To Int(xRowsCount / xInterval) xWs.Range(xWs) .Cells(xNum1, WorkRng.Column), xWs.Cells(xNum1 + xRows - 1, WorkRng.Column)).Válassza ki az Application.Selection.Entire Row.Insert xNum1= xNum1 + xNum2 Next End Sub"
A weboldal moderátora ezt a megjegyzést minimalizálta
nagyon szépen köszönöm!!!!! ez elképesztő
A weboldal moderátora ezt a megjegyzést minimalizálta
Nagyon köszönöm!!
A weboldal moderátora ezt a megjegyzést minimalizálta
Hi


Intervallum vba kódot használok, hogy működik.. De ha 100000 XNUMX feletti sort használok, akkor nem működik.. Kérem, javasolja, mit változtassak, ha van.


Sub InsertRowsAtIntervals()
„Frissítés: 20150707
Dim Rng mint tartomány
Dim xInterval As Integer
Dim xRows As Integer
Dim xRowsCount As Integer
Dim xNum1 Egész számként
Dim xNum2 Egész számként
Dim WorkRng As Range
Dim xWs munkalapként
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Tartomány", xTitleId, WorkRng.Address, Type:=8)
xRowsCount = WorkRng.Rows.Count
xInterval = Application.InputBox("Adja meg a sor intervallumát. ", xTitleId, 1, Type:=1)
xRows = Application.InputBox("Hány sort kell beszúrni az egyes intervallumokban? ", xTitleId, 1, Type:=1)
xNum1 = WorkRng.Row + xInterval
xNum2 = xRows + xInterval
Set xWs = WorkRng.Parent
Ha i = 1 - Int(xRowsCount / xInterval)
xWs.Range(xWs.Cells(xNum1, WorkRng.Column), xWs.Cells(xNum1 + xRows - 1, WorkRng.Column)).
Application.Selection.EntireRow.Insert
xNum1 = xNum1 + xNum2
Következő
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Fantasztikus – sok esztelen adatbeviteltől kíméltél meg, köszönöm szépen
A weboldal moderátora ezt a megjegyzést minimalizálta
szia, hogyan kaphatom meg a megadott számú oszlop beillesztése az adatokba fix időközönként kódját
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia, PK
Ha meghatározott időközönként üres oszlopokat szeretne beszúrni a meglévő adatokba, az alábbi VBA-kód segíthet! Kérjük, próbálja ki.

Sub InsertColumnsAtIntervals()
Dim Rng mint tartomány
Dim xInterval As Integer
Dim xCs As Integer
Dim xCCount As Integer
Dim xNum1 Egész számként
Dim xNum2 Egész számként
Dim WorkRng As Range
Dim xWs munkalapként
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Tartomány", xTitleId, WorkRng.Address, Type:=8)
xCCount = WorkRng.Columns.Count
xInterval = Application.InputBox("Adja meg az oszlop intervallumát. ", xTitleId, 1, Type:=1)
xCs = Application.InputBox("Hány oszlopot kell beszúrni az egyes intervallumokban? ", xTitleId, 1, Type:=1)
xNum1 = WorkRng.Column + xInterval
xNum2 = xCs + xInterval
Set xWs = WorkRng.Parent
I = 1-től Int(xCCount / xInterval)
xWs.Range(xWs.Cells(WorkRng.Row, xNum1 + xCs - 1), xWs.Cells(WorkRng.Row, xNum1)). Válassza
Application.Selection.EntireColumn.Insert
xNum1 = xNum1 + xNum2
Következő
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Hogyan lehet sorokat hozzáadni az Excel adatokhoz az utolsó cellában szereplő szám szerint, mondjuk egy Excel adatban, ha az utolsó cellában a szám 4, hogyan lehet automatikusan hozzáadni 4 sort. egy másik sorban a 72-es szám stb
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia SPGupta!
Egy adott számlista alapján üres sorok beszúrásához használja az alábbi VBA-kódot.
Próbáld ki, remélem tud segíteni!

Al beszúrás()
'Frissítés általExtendoffice
Dim xrg mint tartomány
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Válassza ki a használni kívánt meghatározott számoszlopot (egy oszlop):", "KuTools For Excel", xAddress, , , , , 8)
Ha az xRg semmi, akkor lépjen ki a Subból
Application.ScreenUpdating = Hamis
xLastRow = xRg(1).End(xlDown).Sor
xFstRow = xRg.Row
xCol = xRg.Oszlop
xCount = xRg.Count
Állítsa be az xRg = xRg(1)
I = xLastRow to xFstRow -1 lépés
xNum = Cellák (I, xCol)
Ha IsNumeric(xNum) És xNum > 0 Akkor
Sorok(I + 1).Resize(xNum).Beszúrás
xCount = xCount + xNum
Ha véget
Következő
xRg.Resize(xCount, 1).Válassza ki
Application.ScreenUpdating = Igaz
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia, segítenél kérlek? Hogyan változtathatom meg ezt a kódot úgy, hogy a cellában eggyel kevesebb sorral kevesebb legyen a szám? Például, ha a cellában lévő szám 4, a program adjon hozzá 3 sort. Ha a cellában lévő szám 1, a sorok nem kerülnek hozzáadásra
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Nina,
A feladat megoldásához használja az alábbi kódot:

Al beszúrás()
'Frissítés általExtendoffice
Dim xrg mint tartomány
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Válassza ki a használni kívánt meghatározott számoszlopot (egy oszlop):", "KuTools For Excel", xAddress, , , , , 8)
Ha az xRg semmi, akkor lépjen ki a Subból
Application.ScreenUpdating = Hamis
xLastRow = xRg(1).End(xlDown).Sor
xFstRow = xRg.Row
xCol = xRg.Oszlop
xCount = xRg.Count
Állítsa be az xRg = xRg(1)
I = xLastRow to xFstRow -1 lépés
xNum = Cellák (I, xCol)
xNum = xNum - 1
Ha IsNumeric(xNum) És xNum > 0 Akkor
Sorok(I + 1).Resize(xNum).Beszúrás
xCount = xCount + xNum
Ha véget
Következő
xRg.Resize(xCount, 1).Válassza ki
Application.ScreenUpdating = Igaz
End Sub


Próbáld ki, remélem tud segíteni!
A weboldal moderátora ezt a megjegyzést minimalizálta
Tökéletesen működik, köszönöm szépen!
A weboldal moderátora ezt a megjegyzést minimalizálta
Ez remek. Csak kíváncsi vagyok... és nem tökéletes az angolom, remélem megértitek :) .....
Ki lehet tölteni a hozzáadott üres sorokat abból a sorból származó értékekkel, ahol ez a paraméteres szám volt?
A weboldal moderátora ezt a megjegyzést minimalizálta
Üdvözlöm, Vlagyimir! Úgy érted, hogy üres sorokat kell beszúrni a munkalapon szereplő számlista alapján? Ha igen, kérjük, alkalmazza az alábbi kódot:
Al beszúrás()
'Frissítés általExtendoffice
Dim xrg mint tartomány
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Válassza ki a sorokat beszúrni kívánt számok listáját a következő alapján:", "KuTools For Excel", xAddress, , , , , 8)
Ha az xRg semmi, akkor lépjen ki a Subból
Application.ScreenUpdating = Hamis
xLastRow = xRg(1).End(xlDown).Sor
xFstRow = xRg.Row
xCol = xRg.Oszlop
xCount = xRg.Count
Állítsa be az xRg = xRg(1)
I = xLastRow to xFstRow -1 lépés
xNum = Cellák (I, xCol)
Ha IsNumeric(xNum) És xNum > 0 Akkor
Sorok(I + 1).Resize(xNum).Beszúrás
xCount = xCount + xNum
Ha véget
Következő
xRg.Resize(xCount, 1).Válassza ki
Application.ScreenUpdating = Igaz
Vége SubKérjük, próbálja ki, ha további kérdései vannak, kérjük, kommentelje ide.
A weboldal moderátora ezt a megjegyzést minimalizálta
Ez a kód tökéletes sorok beszúrására....Sub Insert()
'Frissítés általExtendoffice
Dim xrg mint tartomány
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Válassza ki a használni kívánt meghatározott számoszlopot (egy oszlop):", "KuTools For Excel", xAddress, , , , , 8)
Ha az xRg semmi, akkor lépjen ki a Subból
Application.ScreenUpdating = Hamis
xLastRow = xRg(1).End(xlDown).Sor
xFstRow = xRg.Row
xCol = xRg.Oszlop
xCount = xRg.Count
Állítsa be az xRg = xRg(1)
I = xLastRow to xFstRow -1 lépés
xNum = Cellák (I, xCol)
xNum = xNum - 1
Ha IsNumeric(xNum) És xNum > 0 Akkor
Sorok(I + 1).Resize(xNum).Beszúrás
xCount = xCount + xNum
Ha véget
Következő
xRg.Resize(xCount, 1).Válassza ki
Application.ScreenUpdating = Igaz
End Sub

De lehetséges-e... adatokat másolni az üres cellákba abból a sorból, ahol az a paraméteres szám? Feltehetek ide képet? Talán könnyebb, ha megmutatom, mire van szükségem :)
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia, Vlagyimir! Lehet, hogy az alábbi VBA kód segíthet, próbáld ki. Sub CopyRow()
'Frissítés általExtendoffice
Dim xrg mint tartomány
Dim xCRg As Range
Dim xFNum As Integer
Dim xRN As Integer
On Error Resume Next
Tartomány kiválasztása:
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Válassza ki a számlistát", "Kutools for Excel", xTxt, , , , , 8)
Ha az xRg semmi, akkor lépjen ki a Subból

Ha xRg.Columns.Count > 1 Akkor
MsgBox "Kérjük, válasszon egyetlen oszlopot!"
Ugrás a SelectRange-hez
Ha véget
Application.ScreenUpdating = Hamis
Ha xFNum = xRg.Count to 1 Step -1
xCRg = xRg.Item(xFNum) beállítása
xRN = CInt(xCRg.Érték)
Sorokkal (xCRg.Row)
.Másolat
.Resize(xRN).Insert
Vége
Következő
Application.ScreenUpdating = Igaz
End Sub

A weboldal moderátora ezt a megjegyzést minimalizálta
Annyira közel vagyunk egymáshoz :) Most már csak egy sorral kevesebbre van szükségem, mint a legutóbbi VBA kódban, mint a paraméteres szám értékére. Például: Ha a szám 8, akkor 7 sort kell beszúrnunk és másolnunk. Ahogy Ninának készítetted éppen ezzel a PÉLDAVAL
Tehát ha a szám 8, akkor összesen 8 beszúrt és másolt sorunk kell, hogy legyen, az előző VBA kóddal pedig 9.
Tnx
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia! Ebben az esetben a következő kód segíthet, próbálkozzon: Sub CopyData()
'Frissítés által Extendoffice
Dim xRow As Long
Dim VInSertNum As Variant
xSor = 1
Application.ScreenUpdating = Hamis
Do While (Cells(xRow, "A") <> "")
VInSertNum = Cellák (xSor, "B")
If ((VInSertNum > 1) And IsNumeric(VInSertNum)) akkor
Tartomány(Cellák(xSor, "A"), Cellák(xSor, "B")). Másolás
Tartomány (Cellák (xSor + 1, "A"), Cellák (xSor + VInSertNum - 1, "B")).
Selection.Insert Shift:=xlDown
xRow = xRow + VInSertNum - 1
Ha véget
xRow = xRow + 1
Hurok
Application.ScreenUpdating = Hamis
Vége Almegjegyzés: A fenti kódban a betű A az adattartomány kezdő oszlopát és a betűt jelöli B az az oszlopbetű, amely alapján meg akarja másolni a sorokat. Kérjük, változtassa meg őket az Ön igényeinek megfelelően.
A weboldal moderátora ezt a megjegyzést minimalizálta
Van olyan modulod, ami eggyel levonja a másolt számot?
A weboldal moderátora ezt a megjegyzést minimalizálta
Nem. Ez megvan, de szükségem van rá, hogy levonjak 1-et?
Sub CopyRow()
'Frissítés általExtendoffice
Dim xrg mint tartomány
Dim xCRg As Range
Dim xFNum As Integer
Dim xRN As Integer
On Error Resume Next
Tartomány kiválasztása:
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Válassza ki a számlistát", "Kutools for Excel", xTxt, , , , , 8)
Ha az xRg semmi, akkor lépjen ki a Subból

Ha xRg.Columns.Count > 1 Akkor
MsgBox "Kérjük, válasszon egyetlen oszlopot!"
Ugrás a SelectRange-hez
Ha véget
Application.ScreenUpdating = Hamis
Ha xFNum = xRg.Count to 1 Step -1
xCRg = xRg.Item(xFNum) beállítása
xRN = CInt(xCRg.Érték)
Sorokkal (xCRg.Row)
.Másolat
.Resize(xRN).Insert
Vége
Következő
Application.ScreenUpdating = Igaz
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Amit megpróbálok csinálni, az az, hogy több mennyiséget tartalmazó táblázatból címkéket készítek és nyomtatok ki a Wordben?
A weboldal moderátora ezt a megjegyzést minimalizálta
Volt alkalmad megnézni ezt?
A weboldal moderátora ezt a megjegyzést minimalizálta
Az arany áldjon
A weboldal moderátora ezt a megjegyzést minimalizálta
Kódot keresel Excel-lista létrehozásához, egy cellában lévő számmal megduplázva és 1-et kivonva az eredetiből?
A weboldal moderátora ezt a megjegyzést minimalizálta
Köszönet a szerzőnek! Ezekért a legjobb dicséretet érdemled! De kérem, segítsen nekem a kóddal, hogy állandó értéket tegyek az összes üres sorba, amelyet a fenti kóddal hoztam létre? Hogy jobban érthető legyen, be kell szúrnom egy állandó értéket az összes üres sorba (ez már a fenti kóddal megoldódott), majd be kell szúrnom egy állandó értéket az összes üres sorba (ez az én problémám). Köszönöm szíves válaszát.
A weboldal moderátora ezt a megjegyzést minimalizálta
Hello! Az üres sorokat konkrét értékkel akarja kitölteni? Ha igen, akkor a következő cikk segíthet:https://www.extendoffice.com/documents/excel/772-excel-fill-blank-cells-with-0-or-specific-value.html
Kérjük, próbálja ki.
A weboldal moderátora ezt a megjegyzést minimalizálta
Megkaphatom a VBA-kódot a sorok törléséhez a kiválasztott oszlopban lévő ismétlődő értékek alapján, és minden egyedi értéket megtartanak?
A weboldal moderátora ezt a megjegyzést minimalizálta
Helló, Roy! Ha ismétlődő értékeken alapuló sorokat szeretne eltávolítani, akkor általában használja a Távolítsa el a másolatokat Ha VBA-kódra van szüksége, kérjük, használja az alábbi kódot: (Először válassza ki az eltávolítani kívánt adattartományt, majd futtassa ezt a kódot, a sorokat a a kiválasztott első oszlopban szereplő ismétlődő értékek azonnal eltávolításra kerülnek.) Sub Delete_duplicate_rows()
Dim Rng mint tartomány
Állítsa be az Rng = Kiválasztás
Rng.RemoveDuplicates Columns:=Array(1), Header:=xlYes
Az alprogram vége Kérjük, próbálja meg, remélem segíthet!
A weboldal moderátora ezt a megjegyzést minimalizálta
Ez olyan király!! Nagyon köszönöm
A weboldal moderátora ezt a megjegyzést minimalizálta
Muito obrigado, salvou meu trabalho, eu não tinha ideia de como fazer. Muito obrigado mesmo!
A weboldal moderátora ezt a megjegyzést minimalizálta
Helló,
Szívesen. Örülök, hogy segít. Bármilyen kérdése van, forduljon hozzánk bizalommal. Szép napot.
Tisztelettel,
Mandy
A weboldal moderátora ezt a megjegyzést minimalizálta
meg tudnád mondani, hogyan kell ilyen oszlopot beszúrni, mi a kód
A weboldal moderátora ezt a megjegyzést minimalizálta
Helló barát,
Használhatja ezt a VBA kódot:

Sub InsertColumnsAtIntervals()

'Updateby Extendoffice

Dim Rng As Range

Dim xInterval As Integer

Dim xColumns As Integer

Dim xColumnsCount As Integer

Dim xNum1 As Integer

Dim xNum2 As Integer

Dim WorkRng As Range

Dim xWs As Worksheet

xTitleId = "KutoolsforExcel"

Set WorkRng = Application.Selection

Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)

xColumnsCount = WorkRng.Columns.Count

xInterval = Application.InputBox("Enter column interval. ", xTitleId, 1, Type:=1)

xColumns = Application.InputBox("How many columns to insert at each interval? ", xTitleId, 1, Type:=1)

xNum1 = WorkRng.Column + xInterval

xNum2 = xColumns + xInterval

Set xWs = WorkRng.Parent

For i = 1 To Int(xColumnsCount / xInterval)

    xWs.Range(xWs.Cells(WorkRng.Row, xNum1), xWs.Cells(WorkRng.Row, xNum1 + xColumns - 1)).Select

    Application.Selection.EntireColumn.Insert

    xNum1 = xNum1 + xNum2

Next

End Sub


Tisztelettel,
Mandy
A weboldal moderátora ezt a megjegyzést minimalizálta
Вот выручили так выручили!
Сидел, ломал голову как добавить строки по заданному количеству.
Ваш макрос мне очень помог.
Az 5-t az 5-ből kiértékelte
A weboldal moderátora ezt a megjegyzést minimalizálta
Név E-mail Telefon cím
0 Név E-mail Telefon cím
címsor 2 Név Telefon 0
Név E-mail Telefon cím
0 Név E-mail Telefon cím
címsor 2 0


Hogyan szerkeszthetném ezt úgy, hogy minden üres értéknél vagy 0 értéknél új sort kezdjek anélkül, hogy a 0-s telefonszámok új sort kezdenének?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Jarrod

Sajnálom, nem értem egyértelműen a problémádat.
Kifejtenéd részletesebben a problémádat? Vagy beszúrhat ide egy képernyőképet vagy fájlt.
Köszönöm!
A weboldal moderátora ezt a megjegyzést minimalizálta
hola, hay algun codigo que me permita copiar los datos, pero que en la primera columna que son fechas pueda ser consecutivo.

ejemplo

en vez de que quede asi

01. 10-2022 Juan Ramirez
01. 10-2022 Juan Ramirez
01. 10-2022 Juan Ramirez

quede asi

01. 10-2022 Juan Ramirez
02. 10-2022 Juan Ramirez
03. 10-2022 Juan Ramirez

gracias
A weboldal moderátora ezt a megjegyzést minimalizálta
hola, hay algun codigo que me permita copiar los datos, pero que en la primera columna que son fechas puedan ser consecutivas.

ejemplo

en vez de que quede asi

10. 01. 2022. 19.258.369-4 Juan Ramirez
10. 01. 2022. 19.258.369-4 Juan Ramirez
10. 01. 2022. 19.258.369-4 Juan Ramirez

quede asi

10. 01. 2022. 19.258.369-4 Juan Ramirez
11. 01. 2022. 19.258.369-4 Juan Ramirez
12. 01. 2022. 19.258.369-4 Juan Ramirez

gracias
A weboldal moderátora ezt a megjegyzést minimalizálta
Csodálatos vba script!
Több mint 5000 sorom volt, amelyek közé új sorokat kell hozzáadnom. Az összes többi útmutató azt mondta, hogy "segítő" oszlopot készítsek, és az életem jó részét el fogja tölteni, hogy újra és újra hozzáadjak 1,2 másoló beillesztést, csak hogy új sorokat adjak hozzá.
Szóval, köszönöm ezt!
Az 5-t az 5-ből kiértékelte
Még senki sem írt megjegyzést

Kövess minket

Copyright © 2009 - www.extendoffice.com. | Minden jog fenntartva. Powered by ExtendOffice. | Oldaltérkép
A Microsoft és az Office logó a Microsoft Corporation védjegyei vagy bejegyzett védjegyei az Egyesült Államokban és / vagy más országokban.
Sectigo SSL védi