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

Ինչպե՞ս տեղադրել Excel- ում ֆիքսված ընդմիջումներով տողերի որոշակի քանակ:

Excel- ի աշխատանքային թերթում դուք կարող եք դատարկ տող տեղադրել առկա տողերի միջեւ `օգտագործելով Տեղադրման գործառույթը: Բայց, եթե ունեք տվյալների մեծ տիրույթ, և յուրաքանչյուր երրորդ իններորդ շարքից հետո անհրաժեշտ է տեղադրել երկու դատարկ տող, ինչպե՞ս կարող եք արագ և հարմարավետ ավարտել այս գործը:


Տեղադրեք որոշակի շարք դատարկ տողեր տվյալների տիրույթում VBA կոդով ֆիքսված ընդմիջումներով

Հաջորդ VBA կոդը կարող է օգնել գոյություն ունեցող տվյալների մեջ յուրաքանչյուր n-րդ տողից հետո տեղադրել որոշակի քանակի տողեր: Խնդրում ենք անել հետևյալը.

1, Պահեք պահեք ALT + F11 Excel- ի ստեղները, և այն բացում է Microsoft Visual Basic հավելվածների համար պատուհան.

2: Սեղմեք Տեղադրել > Մոդուլներ, և տեղադրեք հետևյալ կոդը Մոդուլի պատուհան.

VBA կոդ. Ֆիքսված ընդմիջումներով տվյալների մեջ տեղադրեք տողերի որոշակի քանակ

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. Այս կոդը փակցնելուց հետո սեղմեք F5 Այս կոդն աշխատեցնելու բանալին դուրս կգա հուշման տուփ ՝ ձեզ հիշեցնելու համար ընտրելով տվյալների տիրույթը, որը ցանկանում եք տեղադրել դատարկ տողեր, տես նկարի նկարը.

4: Սեղմեք OK կոճակը, դուրս կգա մեկ այլ հուշում, խնդրում ենք մուտքագրել տողի միջակայքերի քանակը, տես նկարի նկարը.

5, Անցեք կտտացնելով OK կոճակը, հետևյալ դուրս եկած հուշման վանդակում մուտքագրեք դատարկ շարքերի քանակը, որոնք ցանկանում եք տեղադրել, տես նկարի նկարը.

6. Այնուհետեւ կտտացրեք OK, և դատարկ տողերը տեղադրվել են առկա տվյալների մեջ պարբերական ընդմիջումներով, տե՛ս սքրինշոթեր.


Տեղադրեք որոշակի շարք դատարկ տողեր տվյալների տիրույթում ՝ հիմնված բջջային արժեքների վրա ՝ VBA կոդով

Երբեմն կարող է անհրաժեշտ լինել տեղադրել դատարկ շարքերը ՝ հիմնվելով բջջային արժեքների ցուցակի վրա, այս դեպքում ստորև ներկայացված VBA կոդը կարող է ձեզ լավություն բերել, խնդրում ենք արեք հետևյալ կերպ.

1, Պահեք պահեք ALT + F11 Excel- ի ստեղները, և այն բացում է Microsoft Visual Basic հավելվածների համար պատուհան.

2: Սեղմեք Տեղադրել > Մոդուլներ, և տեղադրեք հետևյալ կոդը Մոդուլի պատուհան.

VBA կոդ. Թվերի ցուցակի հիման վրա տեղադրեք դատարկ շարքերի որոշակի քանակ.

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, Այս կոդը տեղադրելուց հետո սեղմեք F5 Այս կոդը գործարկելու համար ստեղնը դուրս եկած երկխոսության դաշտում ընտրեք այն թվերի ցուցակը, որի հիման վրա ցանկանում եք տեղադրել դատարկ շարքեր, տես նկարի նկարը.

4, Դրանից հետո կտտացրեք OK, և դուք կստանաք անհրաժեշտ արդյունքներ, ինչպես ցույց են տրված հետևյալ նկարները.


Տեղադրեք որոշակի շարք դատարկ տողեր տվյալների տիրույթում ֆիքսված ընդմիջումներով `հարմար գործառույթով

Եթե ​​ծանոթ չեք վերը նշված VBA կոդին, Excel- ի համար նախատեսված գործիքներ նույնպես կարող է օգնել ձեզ, իր Տեղադրեք դատարկ շարքեր և սյունակներ առանձնահատկությունը կարող է արագ և հեշտությամբ ֆիքսված ընդմիջումներով որոշակի թվով տողեր կամ սյուններ տեղադրել առկա տվյալների մեջ:

Նշում:Սա կիրառելու համար Տեղադրեք դատարկ շարքեր և սյունակներ , նախ, դուք պետք է ներբեռնեք այն Excel- ի համար նախատեսված գործիքներ, ապա գործառույթը կիրառեք արագ և հեշտությամբ:

Տեղադրելուց հետո Excel- ի համար նախատեսված գործիքներխնդրում եմ արեք հետևյալը.

1, Ընտրեք տվյալների տիրույթը, որը ցանկանում եք ընդմիջումներով տեղադրել դատարկ տողեր:

2: Սեղմեք Կուտոլս > Տեղադրել > Տեղադրեք դատարկ շարքեր և սյունակներ, տես նկարի նկարը.

3, Մեջ Տեղադրեք դատարկ շարքը և սյունակները երկխոսության վանդակում, ընտրեք Դատարկ շարքեր տարբերակը Տեղադրեք տիպը, ապա նշեք ընդմիջման և դատարկ շարքերի քանակը, որոնք ցանկանում եք օգտագործել որպես ցույց տրված հետևյալ նկարը.

4. Այնուհետեւ կտտացրեք OK կոճակը, և դատարկ տողերը տեղադրվել են ընտրված տիրույթի մեջ որոշակի ընդմիջումով, ինչպես ցույց է տրված հետևյալ նկարը.

Ներբեռնեք և անվճար փորձեք Kutools- ը Excel- ի համար:


VBA կոդով հատուկ թվերի հիման վրա բազմակի պատճենեք և տեղադրեք տողեր

Ենթադրելով, որ դուք ունեք tada- ի մի շարք, և այժմ դուք ցանկանում եք պատճենել յուրաքանչյուր տող և դրանք բազմիցս կպցնել հաջորդ շարքին ՝ հիմնվելով թվերի ցուցակի վրա, ինչպես ցույց է տրված ներքևում նշված սքրինշոթերը: Ինչպե՞ս կարող է լուծել այս խնդիրը Excel- ի աշխատանքային թերթում:

Այս գործով զբաղվելու համար ես ձեզ համար կներկայացնեմ օգտակար ծածկագիր, խնդրում եմ կատարել հետևյալ քայլերը.

1, Պահեք պահեք ALT + F11 Excel- ի ստեղները, և այն բացում է Microsoft Visual Basic հավելվածների համար պատուհան.

2: Սեղմեք Տեղադրել > Մոդուլներ, և տեղադրեք հետևյալ կոդը Մոդուլի պատուհան.

VBA կոդ. Պատճենեք և տեղադրեք տողերը բազմակի անգամ ՝ հիմնվելով հատուկ թվերի վրա.

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, Այս կոդը տեղադրելուց հետո սեղմեք F5 Այս կոդը գործարկելու համար ստեղնը հանված երկխոսության դաշտում ընտրեք այն թվերի ցանկը, որոնք ցանկանում եք պատճենել և տեղադրեք տվյալների շարքերը, որոնց հիման վրա տես նկարի նկարը.

4, Դրանից հետո կտտացրեք OK կոճակը, և տողերի որոշակի քանակը պատճենվել և տեղադրվել են յուրաքանչյուր սկզբնական շարքի տակ, տեսեք սքրինշոթերը.


Copարմանալի առանձնահատկությամբ հատուկ թվերի հիման վրա բազմակի պատճենեք և տեղադրեք տողեր

Եթե ​​դուք ունեք Excel- ի համար նախատեսված գործիքներԻր Կրկնօրինակեք տողերը / սյունակները ՝ հիմնված բջիջների արժեքի վրա առանձնահատկությունը, դուք կարող եք արագ և հեշտությամբ ներդնել շարքերը կամ սյունակները ՝ հիմնվելով թվերի ցուցակի վրա:

Նշում:Սա կիրառելու համար Կրկնօրինակեք տողերը / սյունակները ՝ հիմնված բջիջների արժեքի վրա, նախ, դուք պետք է ներբեռնեք այն Excel- ի համար նախատեսված գործիքներ, ապա գործառույթը կիրառեք արագ և հեշտությամբ:

Տեղադրելուց հետո Excel- ի համար նախատեսված գործիքներխնդրում եմ արեք հետևյալը.

1: Սեղմեք Կուտոլս > Տեղադրել > Կրկնօրինակեք տողերը / սյունակները ՝ հիմնված բջիջների արժեքի վրա, տես նկարի նկարը.

2, Մեջ Պատճենեք և տեղադրեք տողերն ու սյունակները երկխոսության տուփ, ընտրեք Պատճենել և տեղադրել տողերը տարբերակը Տիպ բաժինը, ապա ընտրեք տվյալների տիրույթը, որը ցանկանում եք կրկնօրինակել, և այնուհետև նշեք այն արժեքների ցուցակը, որի վրա ցանկանում եք պատճենել տողերը, տես նկարի նկարը.

4, Դրանից հետո կտտացրեք Ok or Դիմել կոճակը, դուք կստանաք հետևյալ արդյունքը ՝ ըստ ձեզ:

Ներբեռնեք և անվճար փորձեք Kutools- ը Excel- ի համար:

Ավելի հարաբերական հոդվածներ.

  • Պատճենել և զետեղել շարքի մի քանի անգամ կամ կրկնօրինակել շարքի X անգամ
  • Ձեր ամենօրյա աշխատանքում երբևէ փորձե՞լ եք պատճենել տող կամ յուրաքանչյուր տող, այնուհետև մի քանի անգամ տեղադրել ընթացիկ տվյալների շարքում ներքևում աշխատաթերթում: Օրինակ, ես ունեմ մի շարք բջիջներ, այժմ ուզում եմ պատճենել յուրաքանչյուր տող և դրանք 3 անգամ կպցնել հաջորդ շարքում, ինչպես ցույց է տրված հետևյալ նկարը: Ինչպե՞ս կարող էիք գործ ունենալ Excel- ում:
  • Տեղադրեք դատարկ տողեր, երբ արժեքը փոխվում է Excel- ում
  • Ենթադրելով, որ դուք ունեք տվյալների մի շարք, և այժմ դուք ցանկանում եք դատարկ տողեր տեղադրել տվյալների միջև, երբ արժեքը փոխվում է, որպեսզի մեկ սյունակում բաժանեք հաջորդական նույն արժեքները, ինչպես ցույց են տրված հետևյալ նկարները: Այս հոդվածում ես կխոսեմ այս խնդրի լուծման համար ձեզ համար որոշ հնարքների մասին:
  • Տեղադրեք դատարկ տող Excel- ում հատուկ տեքստից հետո
  • Եթե ​​ցանկանում եք ներմուծել դատարկ տողեր որոշակի տեքստից հետո, ինչպես ցույց է տրված սքրինշոթը ցույց տված հետևյալ նկարը, ապա ինչպե՞ս վարվել դրա հետ արագ և հեշտությամբ, առանց ձեռքով դրանք հատ առ հատ տեղադրելու:
  • Պատճենել տողերը մի քանի աշխատանքային թերթերից ՝ հիմնվելով չափանիշների վրա ՝ նոր թերթի մեջ
  • Ենթադրելով, դուք ունեք աշխատանքային գրքույկ երեք աշխատանքային թերթերով, որոնք ունեն նույն ձևաչափումը, ինչպես ցույց է տրված ստորև նշված էկրանի նկարը Այժմ ուզում եք պատճենել այս աշխատանքային թերթերից բոլոր տողերը, որոնք C սյունակում պարունակում են «Ավարտված» տեքստը նոր աշխատանքային թերթ: Ինչպե՞ս կարող եք արագ և հեշտությամբ լուծել այս խնդիրը ՝ առանց դրանց մեկ առ մեկ պատճենելու և տեղադրելու:

Գրասենյակի արտադրողականության լավագույն գործիքները

Excel-ի համար Kutools-ը լուծում է ձեր խնդիրների մեծ մասը և բարձրացնում ձեր արտադրողականությունը 80%-ով

  • Վերաօգտագործել: Արագ տեղադրեք բարդ բանաձևեր, գծապատկերներ և այն ամենը, ինչ դուք նախկինում օգտագործել եք. Ryածկագրել բջիջները գաղտնաբառով; Ստեղծեք փոստային ցուցակ և նամակներ ուղարկել ...
  • Super Formula Bar (հեշտությամբ խմբագրեք տեքստի և բանաձևի բազմաթիվ տողեր); Ընթերցանության դասավորությունը (հեշտությամբ կարդալ և խմբագրել մեծ թվով բջիջներ); Տեղադրել ֆիլտրացված տիրույթում...
  • Միաձուլել բջիջները / տողերը / սյունակները առանց տվյալների կորստի. Պառակտված բջիջների պարունակությունը; Միավորել կրկնօրինակ տողերը / սյունակները... Կանխել կրկնօրինակ բջիջները; Համեմատեք միջակայքերը...
  • Ընտրեք Կրկնօրինակ կամ Եզակի Շարքեր; Ընտրեք դատարկ շարքեր (բոլոր բջիջները դատարկ են); Super Find և Fuzzy Find շատ աշխատանքային գրքույկներում; Պատահական ընտրություն ...
  • Actշգրիտ պատճեն Բազմաթիվ բջիջներ ՝ առանց բանաձևի հղումը փոխելու; Ավտոմատ ստեղծեք հղումներ դեպի մի քանի թերթեր; Տեղադրեք փամփուշտներ, Տուփեր և ավելին ...
  • Քաղվածք տեքստ, Տեքստ ավելացնել, հեռացնել ըստ դիրքի, Հեռացնել տարածությունը; Ստեղծել և տպել էջային ենթագոտիներ; Փոխարկել բջիջների բովանդակության և մեկնաբանությունների միջև...
  • Սուպեր զտիչ (պահպանել և կիրառել ֆիլտրի սխեմաները այլ թերթերի վրա); Ընդլայնված տեսակավորում ըստ ամիս / շաբաթ / օր, հաճախականություն և ավելին; Հատուկ զտիչ համարձակ, շեղատառով ...
  • Միավորել աշխատանքային տետրերը և աշխատանքային թերթերը; Միավորել աղյուսակները ՝ հիմնված հիմնական սյունակների վրա; Տվյալները բաժանեք մի քանի թերթերի; Խմբաքանակի փոխակերպում xls, xlsx և PDF...
  • Ավելի քան 300 հզոր հատկություններ. Աջակցում է Office / Excel 2007-2021 և 365: Աջակցում է բոլոր լեզուներին: Հեշտ տեղակայում ձեր ձեռնարկությունում կամ կազմակերպությունում: Ամբողջական հնարավորություններ 30-օրյա անվճար փորձարկում: 60-օրյա գումարի վերադարձի երաշխիք:
kte էջանիշը 201905

Office Tab- ը Tabbed ինտերֆեյսը բերում է Office, և ձեր աշխատանքը շատ ավելի դյուրին դարձրեք

  • Միացնել ներդիրներով խմբագրումը և ընթերցումը Word, Excel, PowerPoint- ով, Հրատարակիչ, Access, Visio և Project:
  • Բացեք և ստեղծեք բազմաթիվ փաստաթղթեր նույն պատուհանի նոր ներդիրներում, այլ ոչ թե նոր պատուհաններում:
  • Բարձրացնում է ձեր արտադրողականությունը 50%-ով և նվազեցնում մկնիկի հարյուրավոր սեղմումները ձեզ համար ամեն օր:
officetab ներքևում
Տեսակավորել մեկնաբանությունները ըստ
մեկնաբանություններ (39)
Գնահատված 5- ը 5- ից դուրս է · 2 վարկանիշ
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, ես օգտագործում եմ ձեր կոդը (ներքևում), խնդրում եմ, ասեք ինձ, թե ինչպես կարող եմ լրացնել այդ տողերը հատուկ տեքստով դրա մեջ: Ես օգտագործել եմ ձեր կոդը երեք տող մուտքագրելու համար, այն հիանալի աշխատեց, բայց հիմա ես պետք է մուտքագրեմ տեքստը Row1 = Date Row2: = Տեղադրություն Row3 = Հեռախոսահամար Նախապես շնորհակալություն... "Sub InsertRowsAtIntervals() 'Updateby20150707 Dim Rng As Range Dim x Ինտերվալը որպես ամբողջական Dim xRows Որպես Intex Dim xRowsCount որպես ամբողջ Dim xNum1 Որպես ամբողջ թվով Dim xNum2 Որպես ամբողջ թվով Dim WorkRng Որպես տիրույթ Dim xWs Որպես աշխատանքային թերթիկ xTitleId = "KutoolsforExcel" Set WorkRng = WorkRng = WorkRng = Application.Rngengean"d" , WorkRng.Address, Type:=8) xRowsCount = WorkRng.Rows.Count xInterval = Application.InputBox("Մուտքագրեք տողերի միջակայքը. ", xTitleId, 1, Type:=1) xRows = Application.InputBox("Քանի տող զետեղել յուրաքանչյուր ինտերվալում: ", 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)).Ընտրեք Application.Selection.EntireRow.Insert xNum1= xNum1 + xNum2 Հաջորդ վերջը ենթակետ»
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
շատ շնորհակալություն!!!!! սա զարմանալի է
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Շատ շնորհակալություն!!
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Hi


Ես օգտագործում եմ ինտերվալային vba կոդը, այն աշխատում է: Բայց երբ ես օգտագործում եմ 100000 տողից բարձր, այն չի աշխատում: Խնդրում ենք առաջարկել, թե ինչ պետք է փոխեմ, եթե այդպիսիք կան:


SubInsertRowsAtIntervals()
«Թարմացում մինչև 20150707 թթ
Dim Rng որպես միջակայք
Dim xInterval որպես ամբողջ թիվ
Dim xRows որպես ամբողջ թիվ
Dim xRowsCount As Integer
Dim xNum1 որպես ամբողջ թիվ
Dim xNum2 որպես ամբողջ թիվ
Dim WorkRng որպես տիրույթ
Dim xWs As Worksheet
xTitleId = «KutoolsforExcel»
Սահմանել WorkRng = Application.Selection
Սահմանել WorkRng = Application.InputBox ("Range", xTitleId, WorkRng.Address, Type:=8)
xRowsCount = WorkRng.Rows.Count
xInterval = Application.InputBox («Մուտքագրեք տողերի միջակայքը.», xTitleId, 1, Type:=1)
xRows = Application.InputBox («Քանի՞ տող տեղադրել յուրաքանչյուր ինտերվալում», xTitleId, 1, Type:=1)
xNum1 = WorkRng.Row + xInterval
xNum2 = xRows + xInterval
Սահմանել xWs = WorkRng.Parent
i = 1 To Int-ի համար (xRowsCount / xInterval)
xWs.Range(xWs.Cells(xNum1, WorkRng.Column), xWs.Cells(xNum1 + xRows - 1, WorkRng.Column)).Ընտրեք
Application.Selection.EntireRow.Insert
xNum1 = xNum1 + xNum2
հաջորդ
Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ֆանտաստիկ - դուք ինձ փրկեցիք շատ անմիտ տվյալների մուտքագրումից, շատ շնորհակալ եմ
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն, ինչպե՞ս կարող եմ ստանալ ֆիքսված պարբերականությամբ տվյալների մեջ սյունակների որոշակի քանակի տեղադրման կոդը
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, PK,
Որոշակի ընդմիջումներով առկա տվյալների մեջ դատարկ սյունակներ տեղադրելու համար ստորև ներկայացված VBA կոդը կարող է օգնել ձեզ: Խնդրում եմ փորձեք:

SubInsertColumnsAtIntervals()
Dim Rng որպես միջակայք
Dim xInterval որպես ամբողջ թիվ
Dim xCs որպես ամբողջ թիվ
Dim xCCcount որպես ամբողջ թիվ
Dim xNum1 որպես ամբողջ թիվ
Dim xNum2 որպես ամբողջ թիվ
Dim WorkRng որպես տիրույթ
Dim xWs As Worksheet
xTitleId = «KutoolsforExcel»
Սահմանել WorkRng = Application.Selection
Սահմանել WorkRng = Application.InputBox ("Range", xTitleId, WorkRng.Address, Type:=8)
xCCcount = WorkRng.Columns.Count
xInterval = Application.InputBox ("Մուտքագրեք սյունակի միջակայքը. ", xTitleId, 1, Type:=1)
xCs = Application.InputBox («Քանի՞ սյունակ տեղադրել յուրաքանչյուր ինտերվալում», xTitleId, 1, Type:=1)
xNum1 = WorkRng.Column + xInterval
xNum2 = xCs + xInterval
Սահմանել xWs = WorkRng.Parent
I = 1 To Int-ի համար (xCCcount / xInterval)
xWs.Range(xWs.Cells(WorkRng.Row, xNum1 + xCs - 1), xWs.Cells(WorkRng.Row, xNum1)).Ընտրեք
Application.Selection.EntireColumn.Insert
xNum1 = xNum1 + xNum2
հաջորդ
Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ինչպես տողեր ավելացնել excel-ի տվյալների համաձայն՝ ըստ նշված թվի վերջին բջիջում, ասենք, excel-ի տվյալների մեջ, եթե վերջին բջիջը ցույց է տալիս թիվը որպես 4, 4 տող ինքնաբերաբար ավելացնելու եղանակը: մեկ այլ շարքի համարը 72 է և այլն
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, SPGupta,
Հատուկ թվերի ցանկի հիման վրա դատարկ տողեր տեղադրելու համար խնդրում ենք կիրառել ստորև ներկայացված VBA կոդը:
Խնդրում եմ փորձեք, հուսով եմ, որ դա կարող է օգնել ձեզ:

Ենթա ներդիր ()
― ԹարմացնելովExtendoffice
Dim xRg որպես տիրույթ
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
Ս.թ. սխալի Ռեզյումե Next
xAddress = ActiveWindow.RangeSelection.Address
Սահմանել xRg = Application.InputBox («Ընտրեք հատուկ համարի սյունակը, որը պետք է օգտագործվի (մեկ սյունակ).», «KuTools For Excel», xAddress, , , , , 8)
Եթե ​​xRg-ը ոչինչ է, ապա դուրս եկեք Sub
Դիմում. ScreenUpdating = Սուտ է
xLastRow = xRg(1).End(xlDown).Տող
xFstRow = xRg.Row
xCol = xRg.Column
xCount = xRg.Count
Սահմանել xRg = xRg (1)
For I = xLastRow To xFstRow Քայլ -1
xNum = Բջիջներ (I, xCol)
Եթե ​​IsNumeric(xNum) Եվ xNum > 0 Ապա
Տողեր (I + 1). Չափափոխել (xNum): Տեղադրել
xCount = xCount + xNum
Վերջ: Եթե
հաջորդ
xRg.Չափափոխել(xCount, 1).Ընտրեք
Դիմում. ScreenUpdating = ueիշտ է
Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, խնդրում եմ, կարող եք օգնել ինձ: Ինչպե՞ս կարող եմ փոխել այս կոդը՝ գովազդելով մեկ ավելի քիչ տող, քան բջջի համարը: Օրինակ, եթե բջիջում թիվը 4 է, ծրագրում ավելացրեք 3 տող: Եթե ​​վանդակում թիվը 1 է, տողերը չեն ավելացվում
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Նինա,
Ձեր խնդիրը լուծելու համար խնդրում ենք օգտագործել ստորև նշված կոդը.

Ենթա ներդիր ()
― ԹարմացնելովExtendoffice
Dim xRg որպես տիրույթ
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
Ս.թ. սխալի Ռեզյումե Next
xAddress = ActiveWindow.RangeSelection.Address
Սահմանել xRg = Application.InputBox («Ընտրեք հատուկ համարի սյունակը, որը պետք է օգտագործվի (մեկ սյունակ).», «KuTools For Excel», xAddress, , , , , 8)
Եթե ​​xRg-ը ոչինչ է, ապա դուրս եկեք Sub
Դիմում. ScreenUpdating = Սուտ է
xLastRow = xRg(1).End(xlDown).Տող
xFstRow = xRg.Row
xCol = xRg.Column
xCount = xRg.Count
Սահմանել xRg = xRg (1)
For I = xLastRow To xFstRow Քայլ -1
xNum = Բջիջներ (I, xCol)
xNum = xNum - 1
Եթե ​​IsNumeric(xNum) Եվ xNum > 0 Ապա
Տողեր (I + 1). Չափափոխել (xNum): Տեղադրել
xCount = xCount + xNum
Վերջ: Եթե
հաջորդ
xRg.Չափափոխել(xCount, 1).Ընտրեք
Դիմում. ScreenUpdating = ueիշտ է
Վերջ Sub


Խնդրում եմ փորձեք, հուսով եմ, որ դա կարող է օգնել ձեզ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Այն կատարյալ է աշխատում, շատ շնորհակալ եմ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Սա շատ լավ է. Պարզապես զարմանում եմ... և իմ անգլերենը կատարյալ չէ, ուստի հուսով եմ, որ կհասկանաք ինձ :) .....
Հնարավո՞ր է ավելացված դատարկ տողերը լրացնել արժեքներով այն տողից, որտեղ էր այդ պարամետրային թիվը:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, Վլադիմիր, նկատի ունեք դատարկ տողեր ներդնե՞լ աշխատաթերթում թվերի ցանկի հիման վրա: Եթե ​​այո, խնդրում ենք կիրառել ստորև նշված կոդը.
Ենթա ներդիր ()
― ԹարմացնելովExtendoffice
Dim xRg որպես տիրույթ
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
Ս.թ. սխալի Ռեզյումե Next
xAddress = ActiveWindow.RangeSelection.Address
Սահմանել xRg = Application.InputBox («Ընտրեք թվերի ցանկը, որոնք ցանկանում եք տեղադրել տողեր՝ հիմնված.», «KuTools For Excel», xAddress, , , , , 8)
Եթե ​​xRg-ը ոչինչ է, ապա դուրս եկեք Sub
Դիմում. ScreenUpdating = Սուտ է
xLastRow = xRg(1).End(xlDown).Տող
xFstRow = xRg.Row
xCol = xRg.Column
xCount = xRg.Count
Սահմանել xRg = xRg (1)
For I = xLastRow To xFstRow Քայլ -1
xNum = Բջիջներ (I, xCol)
Եթե ​​IsNumeric(xNum) Եվ xNum > 0 Ապա
Տողեր (I + 1). Չափափոխել (xNum): Տեղադրել
xCount = xCount + xNum
Վերջ: Եթե
հաջորդ
xRg.Չափափոխել(xCount, 1).Ընտրեք
Դիմում. ScreenUpdating = ueիշտ է
Ավարտել ենթաԽնդրում ենք փորձել, եթե այլ հարցեր ունեք, խնդրում ենք մեկնաբանել այստեղ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Այս կոդը կատարյալ է տողեր տեղադրելու համար...Sub Insert()
― ԹարմացնելովExtendoffice
Dim xRg որպես տիրույթ
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
Ս.թ. սխալի Ռեզյումե Next
xAddress = ActiveWindow.RangeSelection.Address
Սահմանել xRg = Application.InputBox («Ընտրեք հատուկ համարի սյունակը, որը պետք է օգտագործվի (մեկ սյունակ).», «KuTools For Excel», xAddress, , , , , 8)
Եթե ​​xRg-ը ոչինչ է, ապա դուրս եկեք Sub
Դիմում. ScreenUpdating = Սուտ է
xLastRow = xRg(1).End(xlDown).Տող
xFstRow = xRg.Row
xCol = xRg.Column
xCount = xRg.Count
Սահմանել xRg = xRg (1)
For I = xLastRow To xFstRow Քայլ -1
xNum = Բջիջներ (I, xCol)
xNum = xNum - 1
Եթե ​​IsNumeric(xNum) Եվ xNum > 0 Ապա
Տողեր (I + 1). Չափափոխել (xNum): Տեղադրել
xCount = xCount + xNum
Վերջ: Եթե
հաջորդ
xRg.Չափափոխել(xCount, 1).Ընտրեք
Դիմում. ScreenUpdating = ueիշտ է
Վերջ Sub

Բայց հնարավո՞ր է… այդ դատարկ բջիջների տվյալները պատճենել այն տողից, որտեղ էր այդ պարամետրային թիվը: Կարո՞ղ եմ նկար տեղադրել այստեղ: Միգուցե ավելի հեշտ լինի, եթե ցույց տամ այն, ինչ ինձ պետք է :)
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն, Վլադիմիր, միգուցե ստորև ներկայացված VBA կոդը կարող է օգնել ձեզ, փորձեք այն: Sub CopyRow ()
― ԹարմացնելովExtendoffice
Dim xRg որպես տիրույթ
Dim xCRg որպես միջակայք
Dim xFNum-ը որպես ամբողջ թիվ
Dim xRN որպես ամբողջ թիվ
Ս.թ. սխալի Ռեզյումե Next
Ընտրել միջակայքը:
xTxt = ActiveWindow.RangeSelection.Address
Սահմանել xRg = Application.InputBox («Ընտրեք թվերի ցուցակը», «Kutools for Excel», xTxt, , , , , 8)
Եթե ​​xRg-ը ոչինչ է, ապա դուրս եկեք Sub

Եթե ​​xRg.Columns.Count > 1 Ապա
MsgBox «Խնդրում ենք ընտրել մեկ սյունակ»:
Գնալ դեպի Select Range
Վերջ: Եթե
Դիմում. ScreenUpdating = Սուտ է
xFNum = xRg-ի համար: Հաշվեք մինչև 1 քայլ -1
Սահմանել xCRg = xRg.Item (xFNum)
xRN = CInt (xCRg.Value)
Տողերով (xCRg.Row)
.Պատճենել
.Չափափոխել(xRN).Տեղադրել
Վերջ
հաջորդ
Դիմում. ScreenUpdating = ueիշտ է
Վերջ Sub

Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Մենք այնքան մոտ ենք :) Այն, ինչ ինձ հիմա պետք է, մեկ տող պակաս է, քան նախորդ VBA կոդը, քան պարամետրային թվի արժեքը: Օրինակ. Եթե թիվը 8 է, ապա պետք է տեղադրենք և պատճենենք 7 տող: Ինչպես դու ստեղծեցիր Նինայի համար հենց այս ԿՈՊԻ-ով
Այսպիսով, եթե թիվը 8 է, ապա մենք պետք է ունենանք ընդհանուր 8 տեղադրած և պատճենված տող, իսկ նախորդ VBA կոդով մենք ունենք 9:
Tnx
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև ձեզ, այս դեպքում հետևյալ կոդը կարող է օգնել ձեզ, խնդրում ենք փորձել. SubCopyData ()
― Թարմացնելով Extendoffice
Dim xRow As Long
Dim VinSertNum-ը որպես տարբերակ
xՏող = 1
Դիմում. ScreenUpdating = Սուտ է
Do while (Cells(xRow, "A") <> "")
VInSertNum = Բջիջներ (xRow, «B»)
Եթե ​​((VInSertNum > 1) Եվ IsNumeric(VInSertNum)) Ապա
Շրջանակ (Բջիջներ (xRow, «A»), Բջիջներ (xRow, «B»)). Պատճենել
Շրջանակ (Բջիջներ (xRow + 1, «A»), Բջիջներ (xRow + VInSertNum - 1, «B»)): Ընտրեք
Selection.Insert Shift:=xlDown
xRow = xRow + VInSertNum - 1
Վերջ: Եթե
xRow = xRow + 1
Հանգույց
Դիմում. ScreenUpdating = Սուտ է
Վերջի ԵնթաՆշում. Վերը նշված ծածկագրում տառը A նշում է ձեր տվյալների տիրույթի մեկնարկի սյունակը և տառը B սյունակի նամակն է, որի հիման վրա ցանկանում եք կրկնօրինակել տողերը: Խնդրում եմ դրանք փոխեք ձեր կարիքի:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Դուք ունե՞ք մոդուլ, որը պատճենված թիվը մեկ-ով նվազեցնում է:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ոչ: Ես ունեմ այս մեկը, բայց ինձ պետք է 1-ը հանելու համար:
Sub CopyRow ()
― ԹարմացնելովExtendoffice
Dim xRg որպես տիրույթ
Dim xCRg որպես միջակայք
Dim xFNum-ը որպես ամբողջ թիվ
Dim xRN որպես ամբողջ թիվ
Ս.թ. սխալի Ռեզյումե Next
Ընտրել միջակայքը:
xTxt = ActiveWindow.RangeSelection.Address
Սահմանել xRg = Application.InputBox («Ընտրեք թվերի ցուցակը», «Kutools for Excel», xTxt, , , , , 8)
Եթե ​​xRg-ը ոչինչ է, ապա դուրս եկեք Sub

Եթե ​​xRg.Columns.Count > 1 Ապա
MsgBox «Խնդրում ենք ընտրել մեկ սյունակ»:
Գնալ դեպի Select Range
Վերջ: Եթե
Դիմում. ScreenUpdating = Սուտ է
xFNum = xRg-ի համար: Հաշվեք մինչև 1 քայլ -1
Սահմանել xCRg = xRg.Item (xFNum)
xRN = CInt (xCRg.Value)
Տողերով (xCRg.Row)
.Պատճենել
.Չափափոխել(xRN).Տեղադրել
Վերջ
հաջորդ
Դիմում. ScreenUpdating = ueիշտ է
Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Այն, ինչ ես փորձում եմ անել, Word-ում պիտակներ ստեղծելն ու տպելն է մի քանի քանակով աղյուսակից:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Դուք հնարավորություն ունեցե՞լ եք սա նայելու:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ոսկին օրհնի քեզ
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Փնտրու՞մ եք կոդ՝ excel ցուցակ ստեղծելու համար, որը կրկնօրինակվում է բջիջում գտնվող թվով և բնօրինակի համար հանում 1-ը:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Շնորհակալություն հեղինակ! Դուք արժանի եք լավագույն գովասանքին դրանց համար: Բայց խնդրում եմ, կարո՞ղ եք օգնել ինձ կոդի հարցում, որպեսզի հաստատուն արժեք դնեմ բոլոր դատարկ տողերում, որոնք ստեղծել եմ վերևում ձեր կոդով: Ինձ ավելի պարզ դարձնելու համար ես պետք է հաստատուն արժեք մտցնեմ բոլոր դատարկ տողերում (սա արդեն լուծվել է վերևում գտնվող ձեր կոդով), այնուհետև ես պետք է հաստատուն արժեք տեղադրեմ բոլոր դատարկ տողերում (սա իմ խնդիրն է): Շնորհակալություն, քանի որ ակնկալում եմ ձեր բարի արձագանքը:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Ձեզ, նկատի ունեք լրացնել դատարկ տողերը կոնկրետ արժեքով: Եթե ​​այո, միգուցե հետևյալ հոդվածը կարող է օգնել ձեզ.https://www.extendoffice.com/documents/excel/772-excel-fill-blank-cells-with-0-or-specific-value.html
Խնդրում եմ փորձեք:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Կարո՞ղ եմ ստանալ VBA կոդը՝ ընտրված սյունակում կրկնվող արժեքների հիման վրա տողերը ջնջելու համար՝ պահպանելով բոլոր եզակի արժեքները:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, Ռոյ, Եթե ցանկանում եք հեռացնել կրկնօրինակ արժեքների վրա հիմնված տողերը, սովորաբար, կարող եք օգտագործել Հեռացնել կրկնօրինակները Excel-ում տողերը հեռացնելու հատկանիշ: Իհարկե, եթե Ձեզ անհրաժեշտ է VBA կոդ, խնդրում ենք օգտագործել ստորև նշված կոդը. (նախ, դուք պետք է ընտրեք տվյալների տիրույթը, որը ցանկանում եք հեռացնել, այնուհետև գործարկեք այս կոդը, տողերը՝ հիմնված տողերի վրա. Ձեր ընտրության առաջին սյունակի կրկնօրինակ արժեքները միանգամից կհեռացվեն:) Sub Delete_duplicate_rows()
Dim Rng որպես միջակայք
Սահմանել Rng = Ընտրություն
Rng.RemoveDuplicates Columns:=Array(1), Header:=xlYes
Ավարտել ենթաԽնդրում ենք փորձել, հուսով եմ, որ դա կարող է օգնել ձեզ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Սա այնքան թույն է !! Շատ շնորհակալություն
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Muito obrigado, salvou meu trabalho, eu não tinha ideia de como fazer. Muito obrigado mesmo!
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարեւ,
Խնդրեմ. Ուրախ եմ, որ օգնում է: Ցանկացած հարց, խնդրում ենք ազատ զգալ կապվել մեզ հետ: Հիանալի օր անցկացրեք:
Sincerely,
Mandy
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
կարո՞ղ եք ասել, թե ինչպես կարելի է սյունակ տեղադրել այսպես, որն է կոդը
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարեւ բարեկամ,
Դուք կարող եք օգտագործել այս 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


Sincerely,
Mandy
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Вот выручили так выручили!
Сидел, ломал голову как добавить строки по заданному количеству.
Ваш макрос мне очень помог.
Գնահատված 5- ը 5- ից դուրս է
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Անուն Էլ. փոստ Հեռախոսի հասցե
0 Անուն Էլ. փոստ Հեռախոսի հասցե
հասցեի տող 2 Անուն Հեռախոս 0
Անուն Էլ. փոստ Հեռախոսի հասցե
0 Անուն Էլ. փոստ Հեռախոսի հասցե
հասցեի տող 2 0


Ինչպե՞ս կարող եմ խմբագրել սա, որպեսզի սկսեմ նոր տող յուրաքանչյուր դատարկ արժեքով կամ 0 արժեքով, առանց 0-ով հեռախոսահամարներ սկսելու նոր տող:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Ջարոդ

Կներեք, ես չեմ կարող հստակ հասկանալ ձեր խնդիրը:
Կարո՞ղ եք ավելի մանրամասն բացատրել ձեր խնդիրը: Կամ կարող եք տեղադրել սքրինշոթ կամ ֆայլ այստեղ:
Thank you!
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
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 19.258.369-4 Խուան Ռամիրես
01/10/2022 19.258.369-4 Խուան Ռամիրես
01/10/2022 19.258.369-4 Խուան Ռամիրես

quede asi

01/10/2022 19.258.369-4 Խուան Ռամիրես
02/10/2022 19.258.369-4 Խուան Ռամիրես
03/10/2022 19.258.369-4 Խուան Ռամիրես

շնորհակալություն
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
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 Խուան Ռամիրես
10/01/2022 19.258.369-4 Խուան Ռամիրես
10/01/2022 19.258.369-4 Խուան Ռամիրես

quede asi

10/01/2022 19.258.369-4 Խուան Ռամիրես
11/01/2022 19.258.369-4 Խուան Ռամիրես
12/01/2022 19.258.369-4 Խուան Ռամիրես

շնորհակալություն
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հրաշալի vba սցենար:
Ես ունեի ավելի քան 5000 տող, որոնց միջև պետք է նոր տողեր ավելացնեմ: Մնացած բոլոր ուղեցույցներն ինձ ասացին, որ «օգնական» սյունակ ստեղծեմ, դա ինձ կյանքի լավ մաս կպահանջի՝ նորից ու նորից 1,2 copy paste ավելացնելու համար, պարզապես նոր տողեր ավելացնելու համար:
Այսպիսով, շնորհակալություն դրա համար:
Գնահատված 5- ը 5- ից դուրս է
Առայժմ ոչ մի մեկնաբանություն չկա

Հետեւեք մեզ

Հեղինակային իրավունքի © 2009 - www.extendoffice.com. | Բոլոր իրավունքները պաշտպանված են. Powered by ExtendOffice. | | Կայքի քարտեզ
Microsoft- ը և Office- ի պատկերանշանը հանդիսանում են Microsoft Corporation- ի ապրանքային նշաններ կամ գրանցված ապրանքային նշաններ ԱՄՆ-ում և (կամ) այլ երկրներում:
Պաշտպանված է Sectigo SSL- ի կողմից