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

Jak vložit konkrétní počet řádků v pevných intervalech v aplikaci Excel?

V listu aplikace Excel můžete vložit prázdný řádek mezi existující řádky pomocí funkce Vložit. Ale pokud máte velký rozsah dat a potřebujete vložit dva prázdné řádky po každém třetím nebo druhém řádku, jak byste mohli tuto práci rychle a pohodlně dokončit?


Vložte konkrétní počet prázdných řádků do rozsahu dat v pevných intervalech pomocí kódu VBA

Následující kód VBA vám může pomoci vložit konkrétní počet řádků za každý n-tý řádek v rámci stávajících dat. Postupujte prosím následovně:

1. Podržte ALT + F11 klíče v aplikaci Excel a otevře Microsoft Visual Basic pro aplikace okno.

2, klikněte Vložit > Modula vložte následující kód do Okno modulu.

Kód VBA: Vložte konkrétní počet řádků do dat ve stanovených intervalech

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. Po vložení tohoto kódu stiskněte F5 Klíč ke spuštění tohoto kódu se zobrazí okno s výzvou, které vám připomene výběr rozsahu dat, do kterého chcete vložit prázdné řádky, viz screenshot:

4, klikněte OK Tlačítko, vyskočí další výzva, zadejte počet intervalů řádků, viz screenshot:

5. Pokračujte kliknutím OK Tlačítko, v následujícím vyskakovacím okně s výzvou zadejte počet prázdných řádků, které chcete vložit, viz screenshot:

6. Pak klikněte na tlačítko OK, a prázdné řádky byly vloženy do stávajících dat v pravidelných intervalech, viz screenshoty:


Vložte konkrétní počet prázdných řádků do rozsahu dat na základě hodnot buněk s kódem VBA

Někdy možná budete muset vložit prázdné řádky na základě seznamu hodnot buněk, v tomto případě vám níže uvedený kód VBA může udělat laskavost, udělejte to takto:

1. Podržte ALT + F11 klíče v aplikaci Excel a otevře Microsoft Visual Basic pro aplikace okno.

2, klikněte Vložit > Modula vložte následující kód do Okno modulu.

Kód VBA: Vložte konkrétní počet prázdných řádků na základě seznamu čísel:

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. Po vložení tohoto kódu stiskněte F5 klíč ke spuštění tohoto kódu, ve vyskakovacím dialogovém okně vyberte seznam čísel, na které chcete vložit prázdné řádky, viz screenshot:

4. Potom klepněte na tlačítko OKa výsledky, které potřebujete, získáte na následujících obrázcích obrazovky:


Pomocí praktické funkce můžete do rozsahu dat v určitých intervalech vložit konkrétní počet prázdných řádků

Pokud nejste obeznámeni s výše uvedeným kódem VBA, Kutools pro Excel také vám může pomoci Vložte prázdné řádky a sloupce funkce může vložit konkrétní počet řádků nebo sloupců do stávajících dat ve stanovených intervalech rychle a snadno.

Poznámka:Použít toto Vložte prázdné řádky a sloupce Nejprve byste si měli stáhnout soubor Kutools pro Excela poté tuto funkci rychle a snadno aplikujte.

Po instalaci Kutools pro Excel, postupujte následovně:

1. Vyberte rozsah dat, do kterého chcete vložit intervaly prázdné řádky.

2, klikněte Kutools > Vložit > Vložte prázdné řádky a sloupce, viz screenshot:

3. V Vložte prázdné řádky a sloupce dialogové okno vyberte Prázdné řádky možnost z Vložte typ, a poté zadejte počet intervalů a prázdných řádků, které chcete použít, jako na následujícím obrázku obrazovky:

4. Pak klikněte na tlačítko OK Tlačítko a prázdné řádky byly vloženy do vybraného rozsahu v určitém intervalu, jak ukazuje následující snímek obrazovky:

Stáhněte si zdarma zkušební verzi Kutools pro Excel!


Zkopírujte a vložte řádky několikrát na základě konkrétních čísel pomocí kódu VBA

Předpokládejme, že máte řadu tada, a nyní chcete zkopírovat každý řádek a vložit je několikrát do dalšího řádku na základě seznamu čísel, jak je uvedeno níže. Jak by bylo možné tento úkol vyřešit v listu aplikace Excel?

K řešení této práce vám představím užitečný kód, proveďte prosím následující kroky:

1. Podržte ALT + F11 klíče v aplikaci Excel a otevře Microsoft Visual Basic pro aplikace okno.

2, klikněte Vložit > Modula vložte následující kód do Okno modulu.

Kód VBA: Zkopírujte a vložte řádky několikrát na základě konkrétních čísel:

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. Po vložení tohoto kódu stiskněte F5 klíč ke spuštění tohoto kódu, ve vyskakovacím dialogovém okně vyberte seznam čísel, která chcete zkopírovat, a vložte datové řádky na základě, viz screenshot:

4. Potom klepněte na tlačítko OK tlačítko a konkrétní počet řádků byl zkopírován a vložen pod každý původní řádek, viz screenshoty:


Zkopírujte a vložte řádky několikrát na základě konkrétních čísel s úžasnou funkcí

Pokud máte Kutools pro Excel, S jeho Duplikujte řádky / sloupce na základě hodnoty buňky Pomocí této funkce můžete rychle a snadno vložit řádky nebo sloupce na základě seznamu čísel.

Poznámka:Použít toto Duplikujte řádky / sloupce na základě hodnoty buňkyNejprve byste si měli stáhnout soubor Kutools pro Excela poté tuto funkci rychle a snadno aplikujte.

Po instalaci Kutools pro Excel, postupujte následovně:

1, klikněte Kutools > Vložit > Duplikujte řádky / sloupce na základě hodnoty buňky, viz screenshot:

2. V Zkopírujte a vložte řádky a sloupce dialogové okno vyberte Zkopírujte a vložte řádky možnost v typ Oddíl, poté vyberte rozsah dat, který chcete duplikovat, a poté určete seznam hodnot, na které chcete kopírovat řádky, viz screenshot:

4. Potom klepněte na tlačítko Ok or aplikovat tlačítko, získáte podle potřeby následující výsledek:

Stáhněte si zdarma zkušební verzi Kutools pro Excel!

Více relativních článků:

  • Zkopírujte a vložte řádek vícekrát nebo duplikujte řádek X krát
  • Zkoušeli jste při své každodenní práci zkopírovat řádek nebo každý řádek a poté několikrát vložit pod aktuální datový řádek do listu? Například mám řadu buněk, teď chci zkopírovat každý řádek a vložit je třikrát do dalšího řádku, jak ukazuje následující snímek obrazovky. Jak jste mohli tuto práci zvládnout v aplikaci Excel?
  • Při změně hodnoty v aplikaci Excel vložte prázdné řádky
  • Předpokládejme, že máte rozsah dat a nyní chcete mezi data při změně hodnoty vložit prázdné řádky, abyste mohli oddělit postupné stejné hodnoty v jednom sloupci, jak ukazují následující snímky obrazovky. V tomto článku budu mluvit o některých tricích, jak vyřešit tento problém.
  • Zkopírujte řádky z více pracovních listů na základě kritérií do nového listu
  • Předpokládejme, že máte sešit se třemi listy, které mají stejné formátování jako níže uvedený snímek obrazovky. Nyní chcete zkopírovat všechny řádky z těchto listů, jejichž sloupec C obsahuje text „Dokončeno“, do nového listu. Jak byste mohli tento problém vyřešit rychle a snadno, aniž byste je po jednom ručně kopírovali a vkládali?

Nejlepší kancelářské nástroje produktivity

Kutools pro Excel řeší většinu vašich problémů a zvyšuje vaši produktivitu o 80%

  • Opakované použití: Rychle vložte složité vzorce, grafy a cokoli, co jste dříve používali; Šifrovat buňky s heslem; Vytvořte seznam adresátů a posílat e-maily ...
  • Super Formula Bar (snadno upravit více řádků textu a vzorce); Rozložení pro čtení (snadno číst a upravovat velké množství buněk); Vložit do filtrovaného rozsahu...
  • Sloučit buňky / řádky / sloupce bez ztráty dat; Rozdělit obsah buněk; Zkombinujte duplicitní řádky / sloupce... Zabraňte duplicitním buňkám; Porovnat rozsahy...
  • Vyberte možnost Duplikovat nebo Jedinečný Řádky; Vyberte prázdné řádky (všechny buňky jsou prázdné); Super hledání a fuzzy hledání v mnoha sešitech; Náhodný výběr ...
  • Přesná kopie Více buněk beze změny odkazu na vzorec; Automaticky vytvářet reference do více listů; Vložte odrážky, Zaškrtávací políčka a další ...
  • Extrahujte text, Přidat text, Odebrat podle pozice, Odebrat mezeru; Vytváření a tisk mezisoučtů stránkování; Převod mezi obsahem buněk a komentáři...
  • Super filtr (uložit a použít schémata filtrů na jiné listy); Rozšířené řazení podle měsíce / týdne / dne, frekvence a dalších; Speciální filtr tučnou kurzívou ...
  • Kombinujte sešity a pracovní listy; Sloučit tabulky na základě klíčových sloupců; Rozdělte data do více listů; Dávkový převod xls, xlsx a PDF...
  • Více než 300 výkonných funkcí. Podporuje Office / Excel 2007-2021 a 365. Podporuje všechny jazyky. Snadné nasazení ve vašem podniku nebo organizaci. Plné funkce 30denní bezplatná zkušební verze. 60denní záruka vrácení peněz.
karta kte 201905

Office Tab přináší do Office rozhraní s kartami a usnadňuje vám práci

  • Povolte úpravy a čtení na kartách ve Wordu, Excelu, PowerPointu, Publisher, Access, Visio a Project.
  • Otevřete a vytvořte více dokumentů na nových kartách ve stejném okně, nikoli v nových oknech.
  • Zvyšuje vaši produktivitu o 50%a snižuje stovky kliknutí myší každý den!
officetab dno
Komentáře (38)
Hodnocení 5 z 5 · 1 hodnocení:
Tento komentář byl moderátorem webu minimalizován
Ahoj, používám váš kód (níže), můžete mi prosím říct, jak do něj naplnit tyto řádky vlastním textem. Použil jsem váš kód k zadání tří řádků, fungovalo to perfektně, ale teď musím zadat text Row1 = Datum Row2.= Umístění Row3 = Telefonní číslo Předem děkuji... "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 WorkRng = Application.Selection Set WorkRngd = "RitleTleTput" , WorkRng.Address, Type:=8) xRowsCount = WorkRng.Rows.Count xInterval = Application.InputBox("Zadejte interval řádku. ", xTitleId, 1, Type:=1) xRows = Application.InputBox("Kolik řádků k vložit v každém intervalu? ", 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)).Vyberte Application.Selection.EntireRow.Insert xNum1= xNum1 + xNum2 Next End Sub"
Tento komentář byl moderátorem webu minimalizován
Děkuji mnohokrát!!!!! To je úžasné
Tento komentář byl moderátorem webu minimalizován
Díky moc!!
Tento komentář byl moderátorem webu minimalizován
Hi


Používám intervalový kód vba, jeho funkční .. Ale když používám více než 100000 XNUMX řádků, nefunguje to .. laskavě navrhněte, co bych měl změnit, pokud existuje.


Sub InsertRowsAtIntervals()
'Aktualizace do 20150707
Dim Rng As Range
Dim xInterval jako celé číslo
Dim xRows jako celé číslo
Dim xRowsCount jako celé číslo
Dim xNum1 jako celé číslo
Dim xNum2 jako celé číslo
Dim WorkRng As Range
Dim xWs jako pracovní list
xTitleId = "Kutoolsfor Excel"
Nastavte WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
xRowsCount = WorkRng.Rows.Count
xInterval = Application.InputBox("Zadejte interval řádku.", xTitleId, 1, Type:=1)
xRows = Application.InputBox("Kolik řádků vložit v každém intervalu?", xTitleId, 1, Type:=1)
xNum1 = WorkRng.Row + xInterval
xNum2 = xRows + xInterval
Nastavit xWs = WorkRng.Parent
Pro i = 1 To Int (xRowsCount / xInterval)
xWs.Range(xWs.Cells(xNum1, WorkRng.Column), xWs.Cells(xNum1 + xRows - 1, WorkRng.Column)).Vybrat
Application.Selection.EntireRow.Insert
xNum1 = xNum1 + xNum2
další
End Sub
Tento komentář byl moderátorem webu minimalizován
Fantastické - ušetřili jste mi spoustu bezduchého zadávání dat, děkuji mnohokrát
Tento komentář byl moderátorem webu minimalizován
ahoj, jak mohu získat kód pro vložení určitého počtu sloupců do dat v pevných intervalech
Tento komentář byl moderátorem webu minimalizován
Dobrý den, PK,
Chcete-li vložit prázdné sloupce do existujících dat v určitých intervalech, může vám pomoci níže uvedený kód VBA! Zkuste to prosím.

Sub InsertColumnsAtIntervals()
Dim Rng As Range
Dim xInterval jako celé číslo
Dim xCs jako celé číslo
Dim xCCout jako celé číslo
Dim xNum1 jako celé číslo
Dim xNum2 jako celé číslo
Dim WorkRng As Range
Dim xWs jako pracovní list
xTitleId = "Kutoolsfor Excel"
Nastavte WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
xCCout = WorkRng.Columns.Count
xInterval = Application.InputBox("Zadejte interval sloupce.", xTitleId, 1, Typ:=1)
xCs = Application.InputBox("Kolik sloupců vložit v každém intervalu?", xTitleId, 1, Type:=1)
xNum1 = WorkRng.Column + xInterval
xNum2 = xCs + xInterval
Nastavit xWs = WorkRng.Parent
Pro I = 1 To Int (xCCcount / xInterval)
xWs.Range(xWs.Cells(WorkRng.Row, xNum1 + xCs - 1), xWs.Cells(WorkRng.Row, xNum1)).Vybrat
Application.Selection.EntireColumn.Insert
xNum1 = xNum1 + xNum2
další
End Sub
Tento komentář byl moderátorem webu minimalizován
Jak přidat řádky v datech aplikace Excel podle uvedeného čísla v poslední buňce řekněte v datech aplikace Excel, pokud poslední buňka zobrazuje číslo jako 4, jaký je způsob, jak automaticky dd 4 řádky. v jiném řádku je číslo 72 atd
Tento komentář byl moderátorem webu minimalizován
Ahoj, SPGupta,
Chcete-li vložit prázdné řádky na základě konkrétního číselného seznamu, použijte níže uvedený kód VBA.
Zkuste to prosím, doufám, že vám to pomůže!

Sub Insert()
'AktualizovatExtendoffice
Dim xRg jako rozsah
Ztlumit xAddress jako řetězec
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Vyberte sloupec s konkrétním číslem, který chcete použít (jeden sloupec):", "KuTools For Excel", xAddress, , , , , 8)
Pokud xRg není nic, pak Exit Sub
Application.ScreenUpdating = False
xLastRow = xRg(1).End(xlDown).Řádek
xFstRow = xRg.Row
xCol = xRg.Column
xCount = xRg.Count
Nastavit xRg = xRg(1)
Pro I = xLastRow To xFstRow Krok -1
xNum = buňky (I, xCol)
If IsNumeric(xNum) A xNum > 0 Pak
Řádky(I + 1).Změnit velikost(xNum).Vložit
xCount = xCount + xNum
End If
další
xRg.Resize(xCount, 1).Vybrat
Application.ScreenUpdating = True
End Sub
Tento komentář byl moderátorem webu minimalizován
Ahoj, mohl bys mi prosím pomoct? Jak mohu změnit tento kód na reklamu o jeden méně řádků, než je počet v buňce? Pokud je například číslo v buňce 4, program přidejte 3 řádky. Pokud je číslo v buňce 1, řádky se nepřidávají
Tento komentář byl moderátorem webu minimalizován
Ahoj, Nina,
Chcete-li vyřešit svůj úkol, použijte níže uvedený kód:

Sub Insert()
'AktualizovatExtendoffice
Dim xRg jako rozsah
Ztlumit xAddress jako řetězec
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Vyberte sloupec s konkrétním číslem, který chcete použít (jeden sloupec):", "KuTools For Excel", xAddress, , , , , 8)
Pokud xRg není nic, pak Exit Sub
Application.ScreenUpdating = False
xLastRow = xRg(1).End(xlDown).Řádek
xFstRow = xRg.Row
xCol = xRg.Column
xCount = xRg.Count
Nastavit xRg = xRg(1)
Pro I = xLastRow To xFstRow Krok -1
xNum = buňky (I, xCol)
xNum = xNum - 1
If IsNumeric(xNum) A xNum > 0 Pak
Řádky(I + 1).Změnit velikost(xNum).Vložit
xCount = xCount + xNum
End If
další
xRg.Resize(xCount, 1).Vybrat
Application.ScreenUpdating = True
End Sub


Zkuste to prosím, doufám, že vám to pomůže!
Tento komentář byl moderátorem webu minimalizován
Funguje to perfektně, moc děkuji!
Tento komentář byl moderátorem webu minimalizován
To je skvělé. Jen by mě zajímalo... a moje angličtina není dokonalá, tak doufám, že mi budete rozumět :) .....
Je možné vyplnit přidané prázdné řádky hodnotami z řádku, kde bylo to parametrické číslo?
Tento komentář byl moderátorem webu minimalizován
Dobrý den, Vladimíre, chcete vložit prázdné řádky na základě seznamu čísel v listu? Pokud ano, použijte níže uvedený kód:
Sub Insert()
'AktualizovatExtendoffice
Dim xRg jako rozsah
Ztlumit xAddress jako řetězec
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Vyberte seznam čísel, na která chcete vložit řádky na základě:", "KuTools For Excel", xAddress, , , , , 8)
Pokud xRg není nic, pak Exit Sub
Application.ScreenUpdating = False
xLastRow = xRg(1).End(xlDown).Řádek
xFstRow = xRg.Row
xCol = xRg.Column
xCount = xRg.Count
Nastavit xRg = xRg(1)
Pro I = xLastRow To xFstRow Krok -1
xNum = buňky (I, xCol)
If IsNumeric(xNum) A xNum > 0 Pak
Řádky(I + 1).Změnit velikost(xNum).Vložit
xCount = xCount + xNum
End If
další
xRg.Resize(xCount, 1).Vybrat
Application.ScreenUpdating = True
End SubProsím, zkuste to, pokud máte další otázky, napište sem.
Tento komentář byl moderátorem webu minimalizován
Tento kód je ideální pro vkládání řádků....Sub Insert()
'AktualizovatExtendoffice
Dim xRg jako rozsah
Ztlumit xAddress jako řetězec
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Vyberte sloupec s konkrétním číslem, který chcete použít (jeden sloupec):", "KuTools For Excel", xAddress, , , , , 8)
Pokud xRg není nic, pak Exit Sub
Application.ScreenUpdating = False
xLastRow = xRg(1).End(xlDown).Řádek
xFstRow = xRg.Row
xCol = xRg.Column
xCount = xRg.Count
Nastavit xRg = xRg(1)
Pro I = xLastRow To xFstRow Krok -1
xNum = buňky (I, xCol)
xNum = xNum - 1
If IsNumeric(xNum) A xNum > 0 Pak
Řádky(I + 1).Změnit velikost(xNum).Vložit
xCount = xCount + xNum
End If
další
xRg.Resize(xCount, 1).Vybrat
Application.ScreenUpdating = True
End Sub

Ale je to možné... kopírovat data do těch prázdných buněk z řádku, kde bylo to parametrické číslo? Mohu sem dát obrázek? Možná bude jednodušší, když vám ukážu, co potřebuji :)
Tento komentář byl moderátorem webu minimalizován
Ahoj, Vladimíre, může vám pomoci níže uvedený kód VBA, zkuste to. Sub CopyRow()
'AktualizovatExtendoffice
Dim xRg jako rozsah
Dim xCRg jako rozsah
Dim xFNum jako celé číslo
Dim xRN jako celé číslo
On Error Resume Next
Vybrat rozsah:
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Vyberte seznam čísel", "Kutools pro Excel", xTxt, , , , , 8)
Pokud xRg není nic, pak Exit Sub

Pokud xRg.Columns.Count > 1 Potom
MsgBox "Vyberte prosím jeden sloupec!"
Přejít na výběr rozsahu
End If
Application.ScreenUpdating = False
Pro xFNum = xRg.Počítání do 1 Krok -1
Nastavit xCRg = xRg.Item(xFNum)
xRN = CInt(xCRg.Value)
S řádky (xCRg.Row)
.Kopírovat
.Změnit velikost(xRN).Vložit
Konec s
další
Application.ScreenUpdating = True
End Sub

Tento komentář byl moderátorem webu minimalizován
Jsme tak blízko :) Vše, co nyní potřebuji, je o jeden řádek méně než v posledním kódu VBA, než je hodnota parametrického čísla. Například: Pokud je číslo 8, musíme vložit a zkopírovat 7 řádků. Jak jsi to udělal pro Ninu právě s touto KOPÍRIÍ
Pokud je tedy číslo 8, měli bychom mít celkem 8 vložených a zkopírovaných řádků a s předchozím kódem VBA máme 9.
tnx
Tento komentář byl moderátorem webu minimalizován
Dobrý den, v tomto případě vám může pomoci následující kód, zkuste prosím: Sub CopyData()
'Aktualizovat Extendoffice
Dim xRow As Long
Dim VInSertNum jako varianta
xRow = 1
Application.ScreenUpdating = False
Do While (Cells(xRow, "A") <> "")
VInSertNum = Cells(xRow, "B")
If ((VInSertNum > 1) And IsNumeric(VInSertNum)) Pak
Rozsah(Cells(xRow, "A"), Cells(xRow, "B")).Kopírovat
Rozsah(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "B")).Vybrat
Selection.Insert Shift: = xlDown
xRow = xRow + VInSertNum - 1
End If
xRow = xRow + 1
Smyčka
Application.ScreenUpdating = False
End SubNote: Ve výše uvedeném kódu je písmeno A označuje počáteční sloupec rozsahu dat a písmeno B je písmeno sloupce, podle kterého chcete duplikovat řádky. Změňte je prosím podle svých potřeb.
Tento komentář byl moderátorem webu minimalizován
Máte modul, který odečítá zkopírované číslo po jedničce?
Tento komentář byl moderátorem webu minimalizován
Ne. Mám tuhle, ale potřebuji ji odečíst 1?
Sub CopyRow()
'AktualizovatExtendoffice
Dim xRg jako rozsah
Dim xCRg jako rozsah
Dim xFNum jako celé číslo
Dim xRN jako celé číslo
On Error Resume Next
Vybrat rozsah:
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Vyberte seznam čísel", "Kutools pro Excel", xTxt, , , , , 8)
Pokud xRg není nic, pak Exit Sub

Pokud xRg.Columns.Count > 1 Potom
MsgBox "Vyberte prosím jeden sloupec!"
Přejít na výběr rozsahu
End If
Application.ScreenUpdating = False
Pro xFNum = xRg.Počítání do 1 Krok -1
Nastavit xCRg = xRg.Item(xFNum)
xRN = CInt(xCRg.Value)
S řádky (xCRg.Row)
.Kopírovat
.Změnit velikost(xRN).Vložit
Konec s
další
Application.ScreenUpdating = True
End Sub
Tento komentář byl moderátorem webu minimalizován
Snažím se vytvořit a vytisknout štítky ve Wordu z tabulky s více množstvími?
Tento komentář byl moderátorem webu minimalizován
Měli jste možnost se na to podívat?
Tento komentář byl moderátorem webu minimalizován
Zlato vám žehnej
Tento komentář byl moderátorem webu minimalizován
Hledáte kód pro generování excelového seznamu duplikovaného číslem v buňce a odečtením 1 pro originál?
Tento komentář byl moderátorem webu minimalizován
Děkuji autore! Za ty si zasloužíte tu nejlepší pochvalu! Ale mohli byste mi prosím pomoci s kódem vložit konstantní hodnotu do všech prázdných řádků, které jsem vytvořil pomocí vašeho výše uvedeného kódu? Abych byl jasnější, musím do všech prázdných řádků vložit konstantní hodnotu (toto je vyřešeno již s vaším kódem výše), pak musím do všech prázdných řádků vložit konstantní hodnotu (to je můj problém). Děkuji, protože očekávám vaši laskavou odpověď.
Tento komentář byl moderátorem webu minimalizován
Dobrý den, chcete vyplnit prázdné řádky konkrétní hodnotou? Pokud ano, pomůže vám následující článek:https://www.extendoffice.com/documents/excel/772-excel-fill-blank-cells-with-0-or-specific-value.html
Zkuste to prosím.
Tento komentář byl moderátorem webu minimalizován
Mohu získat kód VBA pro odstranění řádků na základě duplicitních hodnot ve vybraném sloupci se zachováním všech jedinečných hodnot?
Tento komentář byl moderátorem webu minimalizován
Dobrý den, Royi, pokud chcete odstranit řádky na základě duplicitních hodnot, normálně můžete použít Odebrat duplikáty funkce v Excelu k odstranění řádků. Samozřejmě, pokud potřebujete kód VBA, použijte prosím níže uvedený kód: (Nejprve byste měli vybrat rozsah dat, který chcete odstranit, a poté spustit tento kód, řádky založené na duplicitní hodnoty v prvním sloupci vašeho výběru budou okamžitě odstraněny. ) Sub Delete_duplicate_rows()
Dim Rng As Range
Nastavte Rng = výběr
Rng.RemoveDuplicates Columns:=Array(1), Header:=xlYes
End SubProsím, zkuste to, doufám, že vám to pomůže!
Tento komentář byl moderátorem webu minimalizován
To je tak cool!! Díky moc
Tento komentář byl moderátorem webu minimalizován
Muito obrigado, salvou meu trabalho, eu não tinha ideia de como fazer. Muito obrigado mesmo!
Tento komentář byl moderátorem webu minimalizován
Ahoj,
Nemáš zač. Jsem rád, že to pomáhá. V případě jakýchkoli dotazů nás neváhejte kontaktovat. Přeji krásný den.
S pozdravem,
Mandy
Tento komentář byl moderátorem webu minimalizován
můžete mi říct, jak vložit sloupec tímto způsobem, jaký je kód
Tento komentář byl moderátorem webu minimalizován
Hello friend,
Můžete použít tento kód VBA:

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


S pozdravem,
Mandy
Tento komentář byl moderátorem webu minimalizován
Вот выручили так выручили!
Сидел, ломал голову как добавить строки по заданному количеству.
Ваш макрос мне очень помог.
Hodnocení 5 z 5
Tento komentář byl moderátorem webu minimalizován
Jméno Email Telefon Adresa
0 Jméno Email Telefon Adresa
řádek adresy 2 Jméno Telefon 0
Jméno Email Telefon Adresa
0 Jméno Email Telefon Adresa
řádek adresy 2


Jak bych to mohl upravit tak, aby začal nový řádek s každou prázdnou hodnotou nebo hodnotou 0, aniž by telefonní čísla s 0 začínala nový řádek?
Tento komentář byl moderátorem webu minimalizován
Ahoj Jardo

Omlouvám se, nemohu jasně pochopit váš problém.
Mohl byste svůj problém popsat podrobněji? Nebo sem můžete vložit snímek obrazovky nebo soubor.
Děkuji!
Tento komentář byl moderátorem webu minimalizován
Ahoj, seno 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 19.258.369-4 Juan Ramirez
01/10/2022 19.258.369-4 Juan Ramirez
01/10/2022 19.258.369-4 Juan Ramirez

quede asi

01/10/2022 19.258.369-4 Juan Ramirez
02/10/2022 19.258.369-4 Juan Ramirez
03/10/2022 19.258.369-4 Juan Ramirez

díky
Tento komentář byl moderátorem webu minimalizován
Ahoj, seno 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

díky
Zatím zde nejsou žádné komentáře
Zanechat své připomínky
Odesílání jako host
×
Ohodnoťte tento příspěvek:
0   Postavy
Doporučená umístění

Sociální sítě

Copyright © 2009 - www.extendoffice.com. | Všechna práva vyhrazena. Poháněno ExtendOffice. | |. | Sitemap
Microsoft a logo Office jsou ochranné známky nebo registrované ochranné známky společnosti Microsoft Corporation ve Spojených státech a / nebo jiných zemích.
Chráněno Sectigo SSL