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

Cum se introduce un număr specific de rânduri la intervale fixe în Excel?

În foaia de lucru Excel, puteți insera un rând gol între rândurile existente utilizând funcția Inserare. Dar, dacă aveți o gamă largă de date și trebuie să inserați două rânduri goale după fiecare al treilea rând, cum ați putea termina această lucrare rapid și convenabil?


Introduceți un număr specific de rânduri goale în intervalul de date la intervale fixe cu codul VBA

Următorul cod VBA vă poate ajuta să inserați un număr specific de rânduri după fiecare al nouălea rând în datele existente. Vă rugăm să faceți următoarele:

1. Țineți apăsat butonul ALT + F11 tastele în Excel și deschide fișierul Microsoft Visual Basic pentru aplicații fereastră.

2. Clic Insera > Moduleși lipiți următorul cod în Fereastra modulului.

Cod VBA: introduceți un anumit număr de rânduri în date la intervale fixe

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. După lipirea acestui cod, vă rugăm să apăsați F5 tasta pentru a rula acest cod, va apărea o casetă de solicitare pentru a vă reaminti să selectați intervalul de date pe care doriți să îl inserați rânduri goale, consultați captura de ecran:

4. Clic OK buton, va apărea o altă casetă de solicitare, vă rugăm să introduceți numărul de intervale de rând, a se vedea captura de ecran:

5. Continuați să faceți clic OK buton, în următoarea casetă de prompt pop-out, vă rugăm să introduceți numărul de rânduri goale pe care doriți să le inserați, vedeți captura de ecran:

6. Apoi apasa OK, iar rândurile goale au fost inserate în datele existente la intervale regulate, consultați capturi de ecran:


Introduceți un anumit număr de rânduri goale în intervalul de date pe baza valorilor celulei cu cod VBA

Uneori, poate fi necesar să introduceți rândurile goale pe baza unei liste de valori ale celulei, în acest caz, codul VBA de mai jos vă poate face o favoare, vă rugăm să faceți acest lucru:

1. Țineți apăsat butonul ALT + F11 tastele în Excel și deschide fișierul Microsoft Visual Basic pentru aplicații fereastră.

2. Clic Insera > Moduleși lipiți următorul cod în Fereastra modulului.

Cod VBA: introduceți un anumit număr de rânduri goale pe baza unei liste de numere:

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. După lipirea acestui cod, apăsați F5 tasta pentru a rula acest cod, în caseta de dialog pop-out, selectați lista numerelor pe care doriți să inserați rânduri goale pe baza, vedeți captura de ecran:

4. Apoi apasa OK, și veți obține rezultatele de care aveți nevoie după cum urmează:


Introduceți un anumit număr de rânduri goale în intervalul de date la intervale fixe, cu o caracteristică utilă

Dacă nu sunteți familiarizați cu codul VBA de mai sus, Kutools pentru Excel De asemenea, vă poate ajuta Introduceți rânduri și coloane goale caracteristica poate insera rapid și ușor un anumit număr de rânduri sau coloane în datele existente la intervale fixe.

Notă:Pentru a aplica acest lucru Introduceți rânduri și coloane goale , în primul rând, ar trebui să descărcați fișierul Kutools pentru Excel, apoi aplicați caracteristica rapid și ușor.

După instalare Kutools pentru Excel, vă rugăm să faceți următoarele:

1. Selectați intervalul de date pe care doriți să îl inserați la intervale de rânduri goale.

2. Clic Kutools > Insera > Introduceți rânduri și coloane goale, vezi captura de ecran:

3. În Introduceți rândul și coloanele goale caseta de dialog, alegeți Rânduri goale opțiune din Tipul de inserare, apoi specificați numărul de intervale și rânduri goale pe care doriți să le utilizați după cum urmează:

4. Apoi apasa OK , iar rândurile goale au fost inserate în intervalul selectat la un anumit interval, după cum se arată în următoarea captură de ecran:

Descărcați și proba gratuită Kutools pentru Excel acum!


Copiați și inserați rânduri de mai multe ori pe baza unor numere specifice cu cod VBA

Să presupunem că aveți o gamă de tada și acum doriți să copiați fiecare rând și să le lipiți de mai multe ori pe rândul următor pe baza unei liste de numere, așa cum se arată în capturile de ecran de mai jos. Cum ar putea rezolva această sarcină în foaia de lucru Excel?

Pentru a face față acestui job, vă voi introduce un cod util, vă rugăm să parcurgeți pașii următori:

1. Țineți apăsat butonul ALT + F11 tastele în Excel și deschide fișierul Microsoft Visual Basic pentru aplicații fereastră.

2. Clic Insera > Moduleși lipiți următorul cod în Fereastra modulului.

Cod VBA: copiați și inserați rânduri de mai multe ori pe baza unor numere specifice:

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. După lipirea acestui cod, apăsați F5 tasta pentru a rula acest cod, în caseta de dialog pop-out, selectați lista numerelor pe care doriți să le copiați și introduceți rândurile de date pe baza, vedeți captura de ecran:

4. Apoi apasa OK și numărul specific de rânduri au fost copiate și lipite sub fiecare rând original, consultați capturi de ecran:


Copiați și inserați rânduri de mai multe ori pe baza unor numere specifice cu o caracteristică uimitoare

Dacă aveţi Kutools pentru Excel, Cu său Duplicați rânduri / coloane pe baza valorii celulei caracteristică, puteți insera rândurile sau coloanele pe baza listei de numere rapid și ușor.

Notă:Pentru a aplica acest lucru Duplicați rânduri / coloane pe baza valorii celulei, în primul rând, ar trebui să descărcați fișierul Kutools pentru Excel, apoi aplicați caracteristica rapid și ușor.

După instalare Kutools pentru Excel, vă rugăm să faceți următoarele:

1. Clic Kutools > Insera > Duplicați rânduri / coloane pe baza valorii celulei, vezi captura de ecran:

2. În Copiați și inserați rânduri și coloane fereastră de dialog, selectați Copiați și inserați rânduri opțiune în Tip secțiune, apoi selectați intervalul de date pe care doriți să îl copiați, apoi specificați lista valorilor pe care doriți să copiați rândurile pe baza, vedeți captura de ecran:

4. Apoi apasa Ok or Aplică , veți obține următorul rezultat după cum aveți nevoie:

Descărcați și proba gratuită Kutools pentru Excel acum!

Mai multe articole relative:

  • Copiați și inserați rândul de mai multe ori sau copiați rândul X Times
  • În munca dvs. zilnică, ați încercat vreodată să copiați un rând sau fiecare rând și apoi să inserați de mai multe ori sub rândul de date curent într-o foaie de lucru? De exemplu, am o gamă de celule, acum vreau să copiez fiecare rând și să le lipesc de 3 ori pe rândul următor, după cum se arată în următoarea captură de ecran. Cum ați putea face față acestui job în Excel?
  • Introduceți rânduri goale atunci când valoarea se schimbă în Excel
  • Presupunând că aveți o gamă de date și acum doriți să inserați rânduri goale între date atunci când valoarea se schimbă, astfel încât să puteți separa aceleași valori secvențiale într-o singură coloană, după cum se arată în următoarele capturi de ecran. În acest articol, voi vorbi despre câteva trucuri pentru a rezolva această problemă.
  • Copiați rândurile din mai multe foi de lucru pe baza criteriilor într-o foaie nouă
  • Să presupunem că aveți un registru de lucru cu trei foi de lucru care au aceeași formatare ca și imaginea de mai jos. Acum, doriți să copiați toate rândurile din aceste foi de lucru în care coloana C conține textul „Finalizat” într-o nouă foaie de lucru. Cum ați putea rezolva această problemă rapid și ușor fără a le copia și lipi manual unul câte unul?

Cele mai bune instrumente de productivitate Office

Kutools pentru Excel vă rezolvă majoritatea problemelor și vă crește productivitatea cu 80%

  • reutilizarea: Introduceți rapid formule complexe, diagrame și orice ai folosit anterior; Criptați celulele cu parola; Creați o listă de corespondență și trimiteți e-mailuri ...
  • Super Formula Bar (editați cu ușurință mai multe linii de text și formulă); Layout de citire (citiți și editați cu ușurință un număr mare de celule); Lipiți la interval filtrat...
  • Merge celule / rânduri / coloane fără a pierde date; Conținut de celule divizate; Combinați rânduri / coloane duplicate... Prevenirea celulelor duplicate; Comparați gamele...
  • Selectați Duplicat sau Unic Rânduri; Selectați Rânduri goale (toate celulele sunt goale); Super Find și Fuzzy Find în multe cărți de lucru; Selectare aleatorie ...
  • Copie exactă Mai multe celule fără modificarea referinței formulelor; Creați automat referințe la foi multiple; Introduceți gloanțe, Casete de selectare și multe altele ...
  • Extrageți textul, Adăugați text, eliminați după poziție, Eliminați spațiul; Creați și imprimați subtotaluri de paginare; Convertiți conținutul dintre celule și comentarii...
  • Super Filtru (salvați și aplicați scheme de filtrare altor foi); Sortare avansată după lună / săptămână / zi, frecvență și multe altele; Filtru special cu bold, italic ...
  • Combinați cărți de lucru și foi de lucru; Merge Tables pe baza coloanelor cheie; Împărțiți datele în mai multe foi; Conversia în loturi xls, xlsx și PDF...
  • Peste 300 de funcții puternice. Suportă Office / Excel 2007-2021 și 365. Acceptă toate limbile. Implementare ușoară în întreprinderea sau organizația dvs. Funcții complete Probă gratuită de 30 de zile. Garanție de returnare a banilor de 60 de zile.
fila kte 201905

Fila Office aduce interfața cu file în Office și vă face munca mult mai ușoară

  • Activați editarea și citirea cu file în Word, Excel, PowerPoint, Publisher, Access, Visio și Project.
  • Deschideți și creați mai multe documente în filele noi ale aceleiași ferestre, mai degrabă decât în ​​ferestrele noi.
  • Vă crește productivitatea cu 50% și reduce sute de clicuri de mouse pentru dvs. în fiecare zi!
fundul officetab
Comentarii (39)
Evaluat 5 din 5 · evaluări 2
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, folosesc codul dvs. (mai jos), vă rog să-mi spuneți cum pot completa acele rânduri cu text personalizat în el. Am folosit codul dvs. pentru a introduce trei rânduri, a funcționat perfect, dar acum trebuie să introduc textul Row1 = Data Row2.= Location Row3 = Phone Number Mulțumesc anticipat... "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 WorkRng ="Application.Range", xTitle. , WorkRng.Address, Type:=8) xRowsCount = WorkRng.Rows.Count xInterval = Application.InputBox(„Introduceți intervalul rândului. ”, xTitleId, 1, Type:=1) xRows = Application.InputBox(„Câte rânduri trebuie să inserați la fiecare 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)).Selectați Application.Selection.EntireRow.Insert xNum1= xNum1 + xNum2 Next End Sub"
Acest comentariu a fost redus la minimum de moderatorul de pe site
mulțumesc foarte mult!!!!! asta este uimitor
Acest comentariu a fost redus la minimum de moderatorul de pe site
Mulțumesc mult!!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Hi


Folosesc codul interval vba care funcționează..Dar când folosesc peste 100000 de rânduri, nu funcționează.. Vă rugăm să sugerați ce ar trebui să schimb dacă există.


Sub InsertRowsAtIntervals()
„Actualizare până în 20150707
Dim Rng ca rază de acțiune
Dim xInterval ca întreg
Dim xRows ca întreg
Dim xRowsCount ca număr întreg
Dim xNum1 ca întreg
Dim xNum2 ca întreg
Dim WorkRng As Range
Dim xWs ca fișă de lucru
xTitleId = „KutoolsforExcel”
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox(„Range”, xTitleId, WorkRng.Address, Type:=8)
xRowsCount = WorkRng.Rows.Count
xInterval = Application.InputBox ("Introduceți intervalul de rând. ", xTitleId, 1, Type:=1)
xRows = Application.InputBox(„Câte rânduri de inserat la fiecare interval?”, xTitleId, 1, Type:=1)
xNum1 = WorkRng.Row + xInterval
xNum2 = xRânduri + xInterval
Set xWs = WorkRng.Parent
Pentru i = 1 To Int(xRowsCount / xInterval)
xWs.Range(xWs.Cells(xNum1, WorkRng.Column), xWs.Cells(xNum1 + xRows - 1, WorkRng.Column)).Selectați
Application.Selection.EntireRow.Insert
xNum1 = xNum1 + xNum2
Pagina Următoare →
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Fantastic - mi-ai economisit o mulțime de date fără minte, mulțumesc foarte mult
Acest comentariu a fost redus la minimum de moderatorul de pe site
salut, cum pot obține codul pentru inserarea unui anumit număr de coloane în date la intervale fixe
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, PK,
Pentru a insera coloane goale în datele existente la intervale specifice, codul VBA de mai jos vă poate ajuta! Vă rugăm să încercați.

Sub InsertColumnsAtIntervals()
Dim Rng ca rază de acțiune
Dim xInterval ca întreg
Dim xCs ca întreg
Dim xCCount ca număr întreg
Dim xNum1 ca întreg
Dim xNum2 ca întreg
Dim WorkRng As Range
Dim xWs ca fișă de lucru
xTitleId = „KutoolsforExcel”
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox(„Range”, xTitleId, WorkRng.Address, Type:=8)
xCCount = WorkRng.Columns.Count
xInterval = Application.InputBox ("Introduceți intervalul coloanei. ", xTitleId, 1, Type:=1)
xCs = Application.InputBox(„Câte coloane se inserează la fiecare interval?”, xTitleId, 1, Type:=1)
xNum1 = WorkRng.Column + xInterval
xNum2 = xCs + xInterval
Set xWs = WorkRng.Parent
Pentru I = 1 To Int(xCCount / xInterval)
xWs.Range(xWs.Cells(WorkRng.Row, xNum1 + xCs - 1), xWs.Cells(WorkRng.Row, xNum1)).Selectați
Application.Selection.EntireColumn.Insert
xNum1 = xNum1 + xNum2
Pagina Următoare →
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Cum să adăugați rânduri în datele Excel conform numărului menționat în ultima celulă, spuneți într-o date Excel dacă ultima celulă arată numărul ca 4, care este modalitatea de a dd 4 rânduri automat. într-un alt rând numărul este 72 etc
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, SPGupta,
Pentru a insera rânduri goale pe baza unei liste de numere specifice, aplicați codul VBA de mai jos.
Vă rugăm să încercați, sper că vă poate ajuta!

Sub Insert()
'Actualizare deExtendoffice
Dim xRg As Range
Dim xAddress ca șir
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
La data de eroare CV următoare
xAdresa = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox(„Selectați coloana cu numărul specific de utilizat (o singură coloană):”, „KuTools pentru Excel”, xAddress, , , , , 8)
Dacă xRg nu este nimic, ieșiți din sub
Application.ScreenUpdating = Fals
xLastRow = xRg(1).End(xlDown).Row
xFstRow = xRg.Row
xCol = xRg.Coloană
xCount = xRg.Count
Setați xRg = xRg(1)
Pentru I = xLastRow To xFstRow Pasul -1
xNum = celule (I, xCol)
Dacă IsNumeric(xNum) și xNum > 0, atunci
Rânduri(I + 1).Redimensionare(xNum).Inserare
xCount = xCount + xNum
Final, dacă
Pagina Următoare →
xRg.Resize(xCount, 1).Select
Application.ScreenUpdating = Adevărat
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Buna, ma puteti ajuta, va rog? Cum pot schimba acest cod pentru a anunța cu un rând mai puțin decât numărul din celulă? De exemplu, dacă numărul din celulă este 4, programul adăugați 3 rânduri. Dacă numărul din celulă este 1, rândurile nu sunt adăugate
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, Nina,
Pentru a vă rezolva sarcina, vă rugăm să utilizați codul de mai jos:

Sub Insert()
'Actualizare deExtendoffice
Dim xRg As Range
Dim xAddress ca șir
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
La data de eroare CV următoare
xAdresa = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox(„Selectați coloana cu numărul specific de utilizat (o singură coloană):”, „KuTools pentru Excel”, xAddress, , , , , 8)
Dacă xRg nu este nimic, ieșiți din sub
Application.ScreenUpdating = Fals
xLastRow = xRg(1).End(xlDown).Row
xFstRow = xRg.Row
xCol = xRg.Coloană
xCount = xRg.Count
Setați xRg = xRg(1)
Pentru I = xLastRow To xFstRow Pasul -1
xNum = celule (I, xCol)
xNum = xNum - 1
Dacă IsNumeric(xNum) și xNum > 0, atunci
Rânduri(I + 1).Redimensionare(xNum).Inserare
xCount = xCount + xNum
Final, dacă
Pagina Următoare →
xRg.Resize(xCount, 1).Select
Application.ScreenUpdating = Adevărat
End Sub


Vă rugăm să încercați, sper că vă poate ajuta!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Funcționează perfect, mulțumesc mult!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Asta e super. Ma intreb... si engleza mea nu este perfecta asa ca sper ca ma vei intelege :) .....
Este posibil să completați rândurile goale adăugate cu valori din rândul unde a fost acel număr parametric?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, Vladimir, vrei să spui să inserezi rânduri goale pe baza unei liste de numere în foaia de lucru? Dacă da, vă rugăm să aplicați codul de mai jos:
Sub Insert()
'Actualizare deExtendoffice
Dim xRg As Range
Dim xAddress ca șir
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
La data de eroare CV următoare
xAdresa = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Selectați lista de numere pe care doriți să inserați rânduri pe baza:", "KuTools For Excel", xAddress, , , , , 8)
Dacă xRg nu este nimic, ieșiți din sub
Application.ScreenUpdating = Fals
xLastRow = xRg(1).End(xlDown).Row
xFstRow = xRg.Row
xCol = xRg.Coloană
xCount = xRg.Count
Setați xRg = xRg(1)
Pentru I = xLastRow To xFstRow Pasul -1
xNum = celule (I, xCol)
Dacă IsNumeric(xNum) și xNum > 0, atunci
Rânduri(I + 1).Redimensionare(xNum).Inserare
xCount = xCount + xNum
Final, dacă
Pagina Următoare →
xRg.Resize(xCount, 1).Select
Application.ScreenUpdating = Adevărat
End SubVă rugăm să încercați, dacă aveți alte întrebări, vă rugăm să comentați aici.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Acest cod este perfect pentru inserarea rândurilor....Sub Insert()
'Actualizare deExtendoffice
Dim xRg As Range
Dim xAddress ca șir
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
La data de eroare CV următoare
xAdresa = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox(„Selectați coloana cu numărul specific de utilizat (o singură coloană):”, „KuTools pentru Excel”, xAddress, , , , , 8)
Dacă xRg nu este nimic, ieșiți din sub
Application.ScreenUpdating = Fals
xLastRow = xRg(1).End(xlDown).Row
xFstRow = xRg.Row
xCol = xRg.Coloană
xCount = xRg.Count
Setați xRg = xRg(1)
Pentru I = xLastRow To xFstRow Pasul -1
xNum = celule (I, xCol)
xNum = xNum - 1
Dacă IsNumeric(xNum) și xNum > 0, atunci
Rânduri(I + 1).Redimensionare(xNum).Inserare
xCount = xCount + xNum
Final, dacă
Pagina Următoare →
xRg.Resize(xCount, 1).Select
Application.ScreenUpdating = Adevărat
End Sub

Dar este posibil.... copiați datele în acele celule goale din rândul unde era acel număr parametric? Pot posta aici o poza? Poate este mai ușor dacă îți arăt de ce am nevoie :)
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, Vladimir, poate că codul VBA de mai jos vă poate ajuta, vă rugăm să încercați. Sub CopyRow()
'Actualizare deExtendoffice
Dim xRg As Range
Dim xCRg As Range
Dim xFNum ca număr întreg
Dim xRN ca întreg
La data de eroare CV următoare
Selectați intervalul:
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox(„Selectați lista de numere”, „Kutools pentru Excel”, xTxt, , , , , 8)
Dacă xRg nu este nimic, ieșiți din sub

Dacă xRg.Columns.Count > 1, atunci
MsgBox „Vă rugăm să selectați o singură coloană!”
Mergeți la SelectRange
Final, dacă
Application.ScreenUpdating = Fals
Pentru xFNum = xRg.Count To 1 Step -1
Setați xCRg = xRg.Item(xFNum)
xRN = CInt(xCRg.Value)
Cu rânduri (xCRg.Row)
.Copie
.Redimensionare(xRN).Inserare
Se termina cu
Pagina Următoare →
Application.ScreenUpdating = Adevărat
End Sub

Acest comentariu a fost redus la minimum de moderatorul de pe site
Suntem atât de aproape :) Tot ceea ce am nevoie acum este un rând mai puțin decât în ​​ultimul cod VBA, decât valoarea numărului parametric. De exemplu: Dacă numărul este 8, trebuie să inserăm și să copiem 7 rânduri. Așa cum ai făcut pentru Nina doar cu această COPIE
Deci, dacă numărul este 8, atunci ar trebui să avem un total de 8 rânduri inserate și copiate, iar cu codul VBA anterior avem 9.
tnx
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, În acest caz, următorul cod vă poate ajuta, vă rugăm să încercați: Sub CopyData()
'Actualizare de Extendoffice
Dim xRow As Long
Dim VInSertNum ca variantă
xRând = 1
Application.ScreenUpdating = Fals
Do While (Cells(xRow, "A") <> "")
VInSertNum = Cells(xRow, "B")
Dacă ((VInSertNum > 1) și IsNumeric(VInSertNum)) atunci
Interval(Celule(xRând, „A”), Celule(xRând, „B”)).Copiare
Interval(Celele(xRow + 1, „A”), Cells(xRow + VInSertNum - 1, „B”)).Selectați
Selection.Insert Shift:=xlDown
xRow = xRow + VInSertNum - 1
Final, dacă
xRow = xRow + 1
Buclă
Application.ScreenUpdating = Fals
End SubNotă: În codul de mai sus, litera A indică coloana de început a intervalului de date și litera B este litera coloanei pe care doriți să copiați rândurile pe baza căreia. Vă rugăm să le schimbați în funcție de nevoile dvs.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Aveți un modul care scade numărul copiat cu unul?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Nu. Am asta, dar am nevoie de el pentru a deduce 1?
Sub CopyRow()
'Actualizare deExtendoffice
Dim xRg As Range
Dim xCRg As Range
Dim xFNum ca număr întreg
Dim xRN ca întreg
La data de eroare CV următoare
Selectați intervalul:
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox(„Selectați lista de numere”, „Kutools pentru Excel”, xTxt, , , , , 8)
Dacă xRg nu este nimic, ieșiți din sub

Dacă xRg.Columns.Count > 1, atunci
MsgBox „Vă rugăm să selectați o singură coloană!”
Mergeți la SelectRange
Final, dacă
Application.ScreenUpdating = Fals
Pentru xFNum = xRg.Count To 1 Step -1
Setați xCRg = xRg.Item(xFNum)
xRN = CInt(xCRg.Value)
Cu rânduri (xCRg.Row)
.Copie
.Redimensionare(xRN).Inserare
Se termina cu
Pagina Următoare →
Application.ScreenUpdating = Adevărat
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Ceea ce încerc să fac este să creez și să printez etichete în Word dintr-o foaie de calcul cu cantități multiple?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Ai avut ocazia să te uiți la asta?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Aurul să te binecuvânteze
Acest comentariu a fost redus la minimum de moderatorul de pe site
Căutați cod pentru a genera o listă Excel, duplicat cu un număr dintr-o celulă și scăzând 1 pentru original?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Multumesc autor! Meriti cele mai bune laude pentru acestea! Dar, vă rog, ați putea să mă ajutați cu codul pentru a pune o valoare constantă în toate rândurile goale pe care le-am creat cu codul dvs. de mai sus? Pentru a fi mai clar, trebuie să insert o valoare constantă în toate rândurile goale (aceasta este rezolvată deja cu codul dvs. de mai sus), apoi trebuie să inserez o valoare constantă în toate rândurile goale (aceasta este problema mea). Vă mulțumesc pentru că aștept un răspuns amabil.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună ziua, Vreți să completați rândurile goale cu o anumită valoare? Dacă da, poate că următorul articol vă poate ajuta:https://www.extendoffice.com/documents/excel/772-excel-fill-blank-cells-with-0-or-specific-value.html
Vă rugăm să încercați.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Pot obține codul VBA pentru ștergerea rândurilor pe baza valorilor duplicate dintr-o coloană selectată, păstrând toate valorile unice?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună ziua, Roy, Dacă doriți să eliminați rânduri pe baza valorilor duplicate, în mod normal, puteți utiliza Eliminați duplicatele caracteristică din Excel pentru a elimina rândurile. Desigur, dacă aveți nevoie de un cod VBA, vă rugăm să utilizați codul de mai jos: (Mai întâi, ar trebui să selectați intervalul de date pe care doriți să îl eliminați, apoi să rulați acest cod, rândurile bazate pe valorile duplicat din prima coloană a selecției dvs. vor fi eliminate imediat. ) Sub Delete_duplicate_rows()
Dim Rng ca rază de acțiune
Set Rng = Selecție
Rng.RemoveDuplicates Coloane:=Matrice(1), Antet:=xlDa
Încheiați SubVă rugăm să încercați, sper că vă poate ajuta!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Asta este atât de tare!! Mulțumesc mult
Acest comentariu a fost redus la minimum de moderatorul de pe site
Muito obrigado, salvou meu trabalho, eu não tinha idee de como fazer. Muito obrigado mesmo!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Buna,
Cu plăcere. Mă bucur că ajută. Orice întrebări, vă rugăm să nu ezitați să ne contactați. O zi bună.
Cu sinceritate,
Mandy
Acest comentariu a fost redus la minimum de moderatorul de pe site
poți să-mi spui cum să inserez o coloană în acest fel, care este codul
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut prietene,
Puteți folosi acest cod 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


Cu sinceritate,
Mandy
Acest comentariu a fost redus la minimum de moderatorul de pe site
Вот выручили так выручили!
Сидел, ломал голову как добавить строки по заданному количеству.
Ваш макрос мне очень помог.
Evaluat 5 din 5
Acest comentariu a fost redus la minimum de moderatorul de pe site
Nume E-mail Adresa de telefon
0 Nume E-mail Telefon Adresă
linia de adresă 2 Nume Telefon 0
Nume E-mail Telefon Adresa
0 Nume E-mail Telefon Adresă
linia de adresă 2 0


Cum aș putea edita acest lucru pentru a începe un nou rând la fiecare valoare goală sau valoare 0 fără a avea numere de telefon cu 0 încep un nou rând?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, Jarrod

Scuze, nu pot înțelege clar problema ta.
Ai putea explica mai detaliat problema ta? Sau puteți insera o captură de ecran sau un fișier aici.
Mulțumesc!
Acest comentariu a fost redus la minimum de moderatorul de pe site
hola, hay algun codigo care me permita copiar los date, pero que en la prima columna care son fechas pot ser consecutivo.

exemplu

en vez de 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
Acest comentariu a fost redus la minimum de moderatorul de pe site
hola, hay algun codigo care me permita copiar los date, pero que en la prima columna care son fechas pot fi consecutivas.

exemplu

en vez de quede asi

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

quede asi

10 01-2022 Juan Ramirez
11 01-2022 Juan Ramirez
12 01-2022 Juan Ramirez

Gracias
Acest comentariu a fost redus la minimum de moderatorul de pe site
Minunat script VBA!
Am avut peste 5000 de rânduri la care trebuie să adaug rânduri noi între ele. Toți ceilalți ghiduri mi-au spus să fac o coloană „ajutor”, mi-ar lua o bună parte din viața mea să adaug 1,2 copy paste din nou și din nou doar pentru a adăuga rânduri noi.
Deci, mulțumesc pentru asta!
Evaluat 5 din 5
Nu există comentarii postate aici încă
Lăsa comentarii
Postare ca invitat
×
Evaluează această postare:
0   Caractere
Locații sugerate

Urmărește-ne

Copyright © 2009 - www.extendoffice.com. | Toate drepturile rezervate. Cu sprijinul ExtendOffice. | Harta site-ului
Microsoft și sigla Office sunt mărci comerciale sau mărci comerciale înregistrate ale Microsoft Corporation în Statele Unite și / sau în alte țări.
Protejat de Sectigo SSL