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

Excel'de belirli aralıklarla belirli sayıda satır nasıl eklenir?

Excel çalışma sayfasında, Ekle işlevini kullanarak mevcut satırlar arasına boş bir satır ekleyebilirsiniz. Ancak, geniş bir veri yelpazeniz varsa ve her üçüncü veya üçüncü satırdan sonra iki boş satır eklemeniz gerekiyorsa, bu işi nasıl hızlı ve kolay bir şekilde bitirebilirsiniz?


VBA kodu ile sabit aralıklarla veri aralığına belirli sayıda boş satır ekleyin

Aşağıdaki VBA kodu, mevcut verilerdeki her n. Satırdan sonra belirli sayıda satır eklemenize yardımcı olabilir. Lütfen aşağıdaki işlemleri yapın:

1. Basılı tutun ALT + F11 Excel'de anahtarlar ve açılır Uygulamalar için Microsoft Visual Basic pencere.

2. tıklayın Ekle > modülve aşağıdaki kodu Modül Penceresi.

VBA kodu: Verilere belirli aralıklarla belirli sayıda satır ekleyin

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. Bu kodu yapıştırdıktan sonra lütfen F5 Bu kodu çalıştırmak için tuşuna basın, boş satırlar eklemek istediğiniz veri aralığını seçmenizi hatırlatmak için bir istem kutusu açılır, ekran görüntüsüne bakın:

4. tıklayın OK düğmesi, başka bir istem kutusu açılacaktır, lütfen satır aralıklarının sayısını girin, ekran görüntüsüne bakın:

5. Tıklamaya git OK düğmesi, aşağıdaki açılır istem kutusunda, lütfen eklemek istediğiniz boş satır sayısını girin, ekran görüntüsüne bakın:

6. Sonra tıklayın OKve boş satırlar düzenli aralıklarla mevcut verilere eklenmiştir, ekran görüntülerine bakın:


VBA kodu ile hücre değerlerine göre veri aralığına belirli sayıda boş satır ekleyin

Bazen, hücre değerleri listesine dayalı olarak boş satırlar eklemeniz gerekebilir, bu durumda aşağıdaki VBA kodu size bir iyilik yapabilir, lütfen şu şekilde yapın:

1. Basılı tutun ALT + F11 Excel'de anahtarlar ve açılır Uygulamalar için Microsoft Visual Basic pencere.

2. tıklayın Ekle > modülve aşağıdaki kodu Modül Penceresi.

VBA kodu: Bir sayı listesine göre belirli sayıda boş satır girin:

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. Bu kodu yapıştırdıktan sonra F5 Bu kodu çalıştırmak için anahtar, açılan iletişim kutusunda, boş satırlar eklemek istediğiniz sayıların listesini seçin, ekran görüntüsüne bakın:

4. Daha sonra, OKve ihtiyacınız olan sonuçları aşağıdaki ekran görüntüleri olarak alacaksınız:


Kullanışlı bir özellikle sabit aralıklarla veri aralığına belirli sayıda boş satır ekleyin

Yukarıdaki VBA koduna aşina değilseniz, Kutools for Excel ayrıca size yardımcı olabilir, Boş Satırlar ve Sütunlar Ekle özelliği, mevcut verilere belirli aralıklarla hızlı ve kolay bir şekilde belirli sayıda satır veya sütun ekleyebilir.

Not:Bunu uygulamak için Boş Satırlar ve Sütunlar Ekle öncelikle Kutools for Excelve ardından özelliği hızlı ve kolay bir şekilde uygulayın.

Kurduktan sonra Kutools for Excellütfen aşağıdaki işlemleri yapın:

1. Aralıklarla boş satırlar eklemek istediğiniz veri aralığını seçin.

2. tıklayın Kutools > Ekle > Boş Satırlar ve Sütunlar Ekle, ekran görüntüsüne bakın:

3. In Boş Satır ve Sütunlar Ekle diyalog kutusunu seçiniz Boş satırlar seçeneği Tip ekleve ardından aşağıdaki gösterilen ekran görüntüsü olarak kullanmak istediğiniz aralık ve boş satır sayısını belirtin:

4. Sonra tıklayın OK düğmesi ve boş satırlar, gösterilen aşağıdaki ekran görüntüsü gibi belirli bir aralıkta seçilen aralığa eklenmiştir:

Kutools for Excel'i şimdi indirin ve ücretsiz deneyin!


VBA kodu ile belirli numaralara göre satırları birden çok kez kopyalayın ve ekleyin

Farz edelim ki, bir dizi tada'ya sahipsiniz ve şimdi, her satırı kopyalayıp aşağıda gösterilen ekran görüntülerine göre bir sayı listesine göre bir sonraki satıra birden çok kez yapıştırmak istiyorsunuz. Bu görevi Excel çalışma sayfasında nasıl çözebilirim?

Bu işin üstesinden gelmek için, size faydalı bir kod sunacağım, lütfen aşağıdaki adımları uygulayın:

1. Basılı tutun ALT + F11 Excel'de anahtarlar ve açılır Uygulamalar için Microsoft Visual Basic pencere.

2. tıklayın Ekle > modülve aşağıdaki kodu Modül Penceresi.

VBA kodu: Belirli numaralara göre satırları birden çok kez kopyalayın ve ekleyin:

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. Bu kodu yapıştırdıktan sonra F5 Bu kodu çalıştırmak için anahtar, açılan iletişim kutusunda, kopyalamak istediğiniz sayıların listesini seçin ve veri satırlarını temel alarak ekleyin, ekran görüntüsüne bakın:

4. Daha sonra, OK düğmesi ve belirli sayıda satır kopyalayıp her orijinal satırın altına yapıştırılmıştır, ekran görüntülerine bakın:


Şaşırtıcı bir özellik ile belirli sayılara göre satırları birden çok kez kopyalayın ve ekleyin

Eğer varsa Kutools for Excel, Onun ile Hücre değerine göre Yinelenen Satırları / Sütunları özelliği, sayıların listesine göre satırları veya sütunları hızlı ve kolay bir şekilde ekleyebilirsiniz.

Not:Bunu uygulamak için Hücre değerine göre Yinelenen Satırları / Sütunlarıöncelikle Kutools for Excelve ardından özelliği hızlı ve kolay bir şekilde uygulayın.

Kurduktan sonra Kutools for Excellütfen aşağıdaki işlemleri yapın:

1. tıklayın Kutools > Ekle > Hücre değerine göre Yinelenen Satırları / Sütunları, ekran görüntüsüne bakın:

2. In Satırları ve sütunları kopyalayın ve ekleyin iletişim kutusunu seçin Satırları kopyala ve ekle seçeneği Tip bölümünde, çoğaltmak istediğiniz veri aralığını seçin ve ardından satırları temel alarak kopyalamak istediğiniz değerlerin listesini belirtin, ekran görüntüsüne bakın:

4. Daha sonra, Ok or Tamam düğmesi, ihtiyacınız olduğunda aşağıdaki sonucu alacaksınız:

Kutools for Excel'i şimdi indirin ve ücretsiz deneyin!

Daha ilgili makaleler:

  • Satırı Birden Çok Kez Kopyala ve Ekle veya Satırı X Kez Çoğalt
  • Günlük çalışmanızda, hiç bir satırı veya her satırı kopyalamayı ve ardından bir çalışma sayfasındaki geçerli veri satırının altına birden çok kez eklemeyi denediniz mi? Örneğin, bir hücre aralığım var, şimdi, her satırı kopyalamak ve aşağıdaki ekran görüntüsü gibi 3 kez sonraki satıra yapıştırmak istiyorum. Excel'de bu işle nasıl başa çıkabilirsiniz?
  • Excel'de Değer Değiştiğinde Boş Satırlar Ekle
  • Bir dizi veriye sahip olduğunuzu varsayarsak ve şimdi değer değiştiğinde veriler arasına boş satırlar eklemek istiyorsunuz, böylece bir sütundaki sıralı aynı değerleri aşağıda gösterilen ekran görüntüleriyle ayırabilirsiniz. Bu yazıda, bu sorunu çözmeniz için bazı püf noktalarından bahsedeceğim.
  • Excel'de Belirli Metnin Arkasına Boş Satır Ekle
  • Aşağıdaki ekran görüntüsü gibi belirli bir metinden sonra boş satırlar eklemek istiyorsanız, bunları tek tek manuel olarak eklemeden hızlı ve kolay bir şekilde nasıl başa çıkabilirsiniz?
  • Kriterlere Dayalı Birden Çok Çalışma Sayfasından Satırları Yeni Bir Sayfaya Kopyala
  • Diyelim ki, aşağıda gösterilen ekran görüntüsü ile aynı biçimlendirmeye sahip üç çalışma sayfası içeren bir çalışma kitabınız var. Şimdi, bu çalışma sayfalarından C sütununda "Tamamlandı" metnini içeren tüm satırları yeni bir çalışma sayfasına kopyalamak istiyorsunuz. Bunları tek tek elle kopyalayıp yapıştırmadan bu sorunu hızlı ve kolay bir şekilde nasıl çözebilirsiniz?

En İyi Ofis Üretkenliği Araçları

Kutools for Excel Sorunlarınızın Çoğunu Çözer ve Verimliliğinizi% 80 Artırır

  • Yeniden: Hızlıca yerleştirin karmaşık formüller, grafikler ve daha önce kullandığınız her şey; Hücreleri Şifrele şifre ile; Posta Listesi Oluşturun ve e-posta gönder ...
  • Süper Formül Çubuğu (birden çok metin ve formül satırını kolayca düzenleyin); Okuma Düzeni (çok sayıda hücreyi kolayca okuyun ve düzenleyin); Filtrelenmiş Aralığa Yapıştır...
  • Hücreleri / Satırları / Sütunları Birleştirme Veri kaybetmeden; Bölünmüş Hücre İçeriği; Yinelenen Satırları / Sütunları Birleştirme... Yinelenen Hücreleri Önleyin; Aralıkları Karşılaştır...
  • Yinelenen veya Benzersiz'i seçin Satırlar; Boş Satırları Seçin (tüm hücreler boştur); Süper Bul ve Bulanık Bul Birçok Çalışma Kitabında; Rastgele Seçim ...
  • Tam kopya Formül referansını değiştirmeden Birden Çok Hücre; Otomatik Referans Oluştur Birden Çok Sayfaya; Madde İşaretleri Ekle, Onay Kutuları ve daha fazlası ...
  • Metni Çıkar, Metin Ekle, Konuma Göre Kaldır, Alanı Kaldır; Sayfalama Alt Toplamları Oluşturma ve Yazdırma; Hücre İçeriği ve Yorumları Arasında Dönüştür...
  • Süper Filtre (filtre şemalarını kaydedin ve diğer sayfalara uygulayın); Gelişmiş Sıralama ay / hafta / gün, sıklık ve daha fazlasına göre; Özel Filtre kalın, italik ...
  • Çalışma Kitaplarını ve Çalışma Sayfalarını Birleştirin; Tabloları anahtar sütunlara göre birleştirin; Verileri Birden Çok Sayfaya Bölme; Toplu dönüştürme xls, xlsx ve PDF...
  • 300'den fazla güçlü özellik. Office / Excel 2007-2021 ve 365'i destekler. Tüm dilleri destekler. Kuruluşunuzda veya kuruluşunuzda kolay devreye alma. Tam özellikler 30 günlük ücretsiz deneme. 60 günlük para iade garantisi.
kte sekmesi 201905

Office Tab, Office'e Sekmeli Arayüz Getirir ve İşinizi Çok Daha Kolay Hale Getirir

  • Word, Excel, PowerPoint'te sekmeli düzenlemeyi ve okumayı etkinleştirin, Publisher, Access, Visio ve Project.
  • Yeni pencereler yerine aynı pencerenin yeni sekmelerinde birden çok belge açın ve oluşturun.
  • Üretkenliğinizi% 50 artırır ve her gün sizin için yüzlerce fare tıklamasını azaltır!
ofis tabanı
Yorumları sıralama ölçütü
Yorumlar (39)
5 üzerinden 5 olarak derecelendirildi · 2 derecelendirme
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, kodunuzu kullanıyorum (aşağıda) lütfen bana bu satırları özel metinle nasıl doldurabileceğinizi söyler misiniz? Kodunuzu üç satır girmek için kullandım, mükemmel çalıştı ama şimdi Satır1 = Tarih Satır2.= Yer Satır3 = Telefon Numarası Şimdiden teşekkürler... "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 =" Uygulama. , WorkRng.Address, Type:=8) xRowsCount = WorkRng.Rows.Count xInterval = Application.InputBox("Satır aralığını girin. ", xTitleId, 1, Type:=1) xRows = Application.InputBox("Kaç satır ", 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)).Uygulama Seçin.Selection.EntireRow.Insert xNum1= xNum1 + xNum2 Sonraki Uç Alt"
Bu yorum sitedeki moderatör tarafından en aza indirildi
çok teşekkür ederim!!!!! bu harika
Bu yorum sitedeki moderatör tarafından en aza indirildi
Çok teşekkürler!!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Hi


Aralık vba kodunu kullanıyorum, çalışıyor..Ama 100000 satırın üzerinde kullandığımda çalışmıyor.. varsa neyi değiştirmem gerektiğini lütfen önerin.


Alt InsertRowsAtIntervals()
'20150707 güncellemesi
Menzil Olarak Dim Rng
Tamsayı olarak xInterval Dim
xRows'u Tamsayı Olarak Karartın
xRowsCount'u Tamsayı Olarak Karartın
Tamsayı Olarak Dim xNum1
Tamsayı Olarak Dim xNum2
Aralık Olarak Dim WorkRng
Çalışma Sayfası Olarak Dim xWs
xTitleId = "KutoolsforExcel"
WorkRng = Application.Selection olarak ayarlayın
WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) olarak ayarlayın
xRowsCount = WorkRng.Rows.Count
xInterval = Application.InputBox("Satır aralığını girin. ", xTitleId, 1, Tür:=1)
xRows = Application.InputBox("Her aralıkta kaç satır eklenecek? ", xTitleId, 1, Type:=1)
xNum1 = WorkRng.Row + xInterval
xSayı2 = xSatırlar + xAralık
xW'leri ayarla = WorkRng.Parent
i = 1 To Int(xRowsCount / xInterval) için
xWs.Range(xWs.Cells(xNum1, WorkRng.Column), xWs.Cells(xNum1 + xRows - 1, WorkRng.Column))).Seçin
Application.Selection.EntireRow.Insert
xSayı1 = xSayı1 + xSayı2
Sonraki
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Fantastik - beni bir sürü akılsız veri girişinden kurtardın, çok teşekkür ederim
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba, sabit aralıklarla verilere belirli sayıda sütun ekleme kodunu nasıl alabilirim
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, PK,
Mevcut verilere belirli aralıklarla boş sütunlar eklemek için aşağıdaki VBA kodu size yardımcı olabilir! Lütfen dene.

Alt InsertColumnsAtIntervals()
Menzil Olarak Dim Rng
Tamsayı olarak xInterval Dim
Tamsayı Olarak Dim xCs
Tamsayı Olarak Dim xCCount
Tamsayı Olarak Dim xNum1
Tamsayı Olarak Dim xNum2
Aralık Olarak Dim WorkRng
Çalışma Sayfası Olarak Dim xWs
xTitleId = "KutoolsforExcel"
WorkRng = Application.Selection olarak ayarlayın
WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) olarak ayarlayın
xCCunt = WorkRng.Columns.Count
xInterval = Application.InputBox("Sütun aralığını girin. ", xTitleId, 1, Tür:=1)
xCs = Application.InputBox("Her aralıkta kaç sütun eklenecek? ", xTitleId, 1, Type:=1)
xNum1 = WorkRng.Column + xInterval
xNum2 = xCs + xAralık
xW'leri ayarla = WorkRng.Parent
I = 1 To Int(xCCount / xInterval) için
xWs.Range(xWs.Cells(WorkRng.Row, xNum1 + xCs - 1), xWs.Cells(WorkRng.Row, xNum1)).Seçin
Application.Selection.EntireColumn.Insert
xSayı1 = xSayı1 + xSayı2
Sonraki
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Excel verilerinde son hücrede belirtilen sayıya göre satırlar nasıl eklenir, eğer son hücre sayı 4 olarak gösteriliyorsa, bir excel verisinde söyleyin, otomatik olarak 4 satırı dd yapmanın yolu nedir. başka bir satırda sayı 72, vb.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, SPGupta,
Belirli numara listesine göre boş satırlar eklemek için lütfen aşağıdaki VBA kodunu uygulayın.
Lütfen deneyin, umarım size yardımcı olabilir!

Alt Ekle()
'güncellemeExtendoffice
Aralık olarak Dim xRg
Dize Olarak xAddress Dim
Dim I, xNum, xLastRow, xFstRow, xCol, Uzun Süreli xCount
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Kullanılacak belirli sayı sütununu seçin(tek sütun):", "KuTools For Excel", xAddress, , , , , , 8)
xRg Hiçbir Şey Değilse, Sub'dan Çıkın
Application.ScreenUpdating = Yanlış
xLastRow = xRg(1).End(xlDown).Satır
xFstRow = xRg.Satır
xCol = xRg.Sütun
xCount = xRg.Count
xRg = xRg(1) olarak ayarla
I için = xLastRow'dan xFstRow'a Adım -1
xNum = Hücreler(I, xCol)
IsNumeric(xNum) Ve xNum > 0 ise
Satırlar(I + 1).Resize(xNum).Insert
xCount = xCount + xNum
Eğer son
Sonraki
xRg.Resize(xCount, 1).Seç
Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, lütfen bana yardım eder misiniz? Bu kodu, hücredeki sayıdan bir satır daha az reklam verecek şekilde nasıl değiştirebilirim? Örneğin, hücredeki sayı 4 ise, program 3 satır ekleyin. Hücredeki sayı 1 ise satırlar eklenmez
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, Nina,
Görevinizi çözmek için lütfen aşağıdaki kodu kullanın:

Alt Ekle()
'güncellemeExtendoffice
Aralık olarak Dim xRg
Dize Olarak xAddress Dim
Dim I, xNum, xLastRow, xFstRow, xCol, Uzun Süreli xCount
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Kullanılacak belirli sayı sütununu seçin(tek sütun):", "KuTools For Excel", xAddress, , , , , , 8)
xRg Hiçbir Şey Değilse, Sub'dan Çıkın
Application.ScreenUpdating = Yanlış
xLastRow = xRg(1).End(xlDown).Satır
xFstRow = xRg.Satır
xCol = xRg.Sütun
xCount = xRg.Count
xRg = xRg(1) olarak ayarla
I için = xLastRow'dan xFstRow'a Adım -1
xNum = Hücreler(I, xCol)
xSayı = xSayı - 1
IsNumeric(xNum) Ve xNum > 0 ise
Satırlar(I + 1).Resize(xNum).Insert
xCount = xCount + xNum
Eğer son
Sonraki
xRg.Resize(xCount, 1).Seç
Application.ScreenUpdating = True
End Sub


Lütfen deneyin, umarım size yardımcı olabilir!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Mükemmel çalışıyor, çok teşekkür ederim!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu harika. Sadece merak ediyorum... ve İngilizcem mükemmel değil bu yüzden beni anlayacağını umuyorum :) .....
Eklenen boş satırları, bu parametrik sayının bulunduğu satırdaki değerlerle doldurmak mümkün müdür?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Vladimir, Çalışma sayfasındaki bir numara listesine göre boş satırlar eklemek mi istiyorsunuz? Eğer öyleyse, lütfen aşağıdaki kodu uygulayın:
Alt Ekle()
'güncellemeExtendoffice
Aralık olarak Dim xRg
Dize Olarak xAddress Dim
Dim I, xNum, xLastRow, xFstRow, xCol, Uzun Süreli xCount
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Satır eklemek istediğiniz sayıların listesini seçin:", "KuTools For Excel", xAddress, , , , , , 8)
xRg Hiçbir Şey Değilse, Sub'dan Çıkın
Application.ScreenUpdating = Yanlış
xLastRow = xRg(1).End(xlDown).Satır
xFstRow = xRg.Satır
xCol = xRg.Sütun
xCount = xRg.Count
xRg = xRg(1) olarak ayarla
I için = xLastRow'dan xFstRow'a Adım -1
xNum = Hücreler(I, xCol)
IsNumeric(xNum) Ve xNum > 0 ise
Satırlar(I + 1).Resize(xNum).Insert
xCount = xCount + xNum
Eğer son
Sonraki
xRg.Resize(xCount, 1).Seç
Application.ScreenUpdating = True
End SubLütfen deneyin, başka sorularınız varsa lütfen buraya yorum yapın.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu kod, satır eklemek için mükemmeldir....Sub Insert()
'güncellemeExtendoffice
Aralık olarak Dim xRg
Dize Olarak xAddress Dim
Dim I, xNum, xLastRow, xFstRow, xCol, Uzun Süreli xCount
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Kullanılacak belirli sayı sütununu seçin(tek sütun):", "KuTools For Excel", xAddress, , , , , , 8)
xRg Hiçbir Şey Değilse, Sub'dan Çıkın
Application.ScreenUpdating = Yanlış
xLastRow = xRg(1).End(xlDown).Satır
xFstRow = xRg.Satır
xCol = xRg.Sütun
xCount = xRg.Count
xRg = xRg(1) olarak ayarla
I için = xLastRow'dan xFstRow'a Adım -1
xNum = Hücreler(I, xCol)
xSayı = xSayı - 1
IsNumeric(xNum) Ve xNum > 0 ise
Satırlar(I + 1).Resize(xNum).Insert
xCount = xCount + xNum
Eğer son
Sonraki
xRg.Resize(xCount, 1).Seç
Application.ScreenUpdating = True
End Sub

Ama bu parametrik sayının olduğu satırdaki boş hücrelerdeki verileri kopyalamak mümkün mü? buraya resim koyabilir miyim Belki sana ihtiyacım olanı göstersem daha kolay olur :)
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Vladimir, Aşağıdaki VBA kodu size yardımcı olabilir, lütfen deneyin. Alt CopyRow()
'güncellemeExtendoffice
Aralık olarak Dim xRg
Aralık olarak xCRg'yi karart
Tamsayı olarak xFNum Dim
Tamsayı olarak xRN'yi karart
On Error Resume Next
Seçim Aralığı:
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Numara listesini seçin", "Kutools for Excel", xTxt, , , , , 8)
xRg Hiçbir Şey Değilse, Sub'dan Çıkın

xRg.Columns.Count > 1 ise
MsgBox "Lütfen tek sütun seçin!"
Seçim Aralığına Git
Eğer son
Application.ScreenUpdating = Yanlış
xFNum için = xRg.Sayı 1 Adım -1
xCRg = xRg.Item(xFNum) olarak ayarla
xRN = CInt(xCRg.Değer)
Satırlar ile(xCRg.Row)
.Kopyala
.Resize(xRN).Ekle
İle bitmek
Sonraki
Application.ScreenUpdating = True
End Sub

Bu yorum sitedeki moderatör tarafından en aza indirildi
Çok yakınız :) Şimdi ihtiyacım olan tek şey, son VBA kodundan bir satır eksik, parametrik sayı değerinden bir satır daha az. Örneğin: Sayı 8 ise 7 satır ekleyip kopyalamamız gerekiyor. Sadece bu KOPYA ile Nina için yaptığın gibi
Yani, sayı 8 ise, o zaman toplam 8 eklenmiş ve kopyalanmış satıra sahip olmalıyız ve önceki VBA koduyla 9'umuz var.
Tnx
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, Bu durumda aşağıdaki kod size yardımcı olabilir, lütfen deneyin: Alt CopyData()
'güncelleme Extendoffice
xRow'u Uzunlukta Karart
Varyant olarak Dim VInsertNum
xSatır = 1
Application.ScreenUpdating = Yanlış
Süre Yap (Cells(xRow, "A") <> "")
VInSertNum = Hücreler(xRow, "B")
Eğer ((VInSertNum > 1) Ve IsNumeric(VInSertNum)) ise
Aralık(Hücreler(xRow, "A")), Hücreler(xRow, "B")).Kopyala
Aralık(Hücreler(xRow + 1, "A")), Hücreler(xRow + VInSertNum - 1, "B")).Seçin
Selection.Insert Shift: = xlDown
xRow = xRow + VInSertNum - 1
Eğer son
xSatır = xSatır + 1
döngü
Application.ScreenUpdating = Yanlış
End SubNote: Yukarıdaki kodda, harf A veri aralığınızın başlangıç ​​sütununu ve harfini gösterir B satırları temel alarak çoğaltmak istediğiniz sütun harfidir. Lütfen bunları ihtiyacınıza göre değiştirin.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Kopyalanan numarayı birer birer çıkaran bir modülünüz var mı?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Hayır. Buna sahibim ama 1'i çıkarmam gerekiyor?
Alt CopyRow()
'güncellemeExtendoffice
Aralık olarak Dim xRg
Aralık olarak xCRg'yi karart
Tamsayı olarak xFNum Dim
Tamsayı olarak xRN'yi karart
On Error Resume Next
Seçim Aralığı:
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Numara listesini seçin", "Kutools for Excel", xTxt, , , , , 8)
xRg Hiçbir Şey Değilse, Sub'dan Çıkın

xRg.Columns.Count > 1 ise
MsgBox "Lütfen tek sütun seçin!"
Seçim Aralığına Git
Eğer son
Application.ScreenUpdating = Yanlış
xFNum için = xRg.Sayı 1 Adım -1
xCRg = xRg.Item(xFNum) olarak ayarla
xRN = CInt(xCRg.Değer)
Satırlar ile(xCRg.Row)
.Kopyala
.Resize(xRN).Ekle
İle bitmek
Sonraki
Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Yapmaya çalıştığım şey, birden çok miktar içeren bir elektronik tablodan Word'de etiketler oluşturmak ve yazdırmak mı?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Buna bakma şansınız oldu mu?
Bu yorum sitedeki moderatör tarafından en aza indirildi
altın seni korusun
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bir hücrede bir sayı ile çoğalan ve orijinal için 1 çıkaran bir excel listesi oluşturmak için kod mu arıyorsunuz?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Teşekkürler yazar! Bunlar için en iyi övgüyü hak ediyorsun! Ama lütfen yukarıdaki kodunuzla oluşturduğum tüm boş satırlara sabit bir değer koymak için kod konusunda bana yardımcı olabilir misiniz? Kendimi daha açık hale getirmek için, tüm boş satırlara sabit bir değer eklemem gerekiyor (bu, yukarıdaki kodunuzla zaten çözüldü), ardından tüm boş satırlara sabit bir değer eklemem gerekiyor (bu benim sorunum). Nazik yanıtınızı beklediğim için teşekkür ederim.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, boş satırları belirli bir değerle doldurmak mı istiyorsunuz? Eğer öyleyse, aşağıdaki makale size yardımcı olabilir:https://www.extendoffice.com/documents/excel/772-excel-fill-blank-cells-with-0-or-specific-value.html
Lütfen dene.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Tüm benzersiz değerleri koruyarak seçilen bir sütundaki yinelenen değerlere dayalı olarak satırların silinmesi için VBA kodunu alabilir miyim?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Roy, Yinelenen değerlere dayalı satırları kaldırmak istiyorsanız, normalde, Yinelemeleri Kaldır Excel'de satırları kaldırmak için bir özellik.Tabii ki, bir VBA koduna ihtiyacınız varsa, lütfen aşağıdaki kodu kullanın: (Önce, kaldırmak istediğiniz veri aralığını seçmeli ve ardından bu kodu, satırları temel alarak çalıştırmalısınız. seçiminizin ilk sütunundaki yinelenen değerler bir kerede kaldırılacaktır. ) Alt Delete_duplicate_rows()
Menzil Olarak Dim Rng
Set Rng = Seçim
Rng.RemoveDuplicates Sütunlar:=Array(1), Başlık:=xlEvet
End SubLütfen deneyin, umarım size yardımcı olabilir!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu çok havalı!! Çok teşekkürler
Bu yorum sitedeki moderatör tarafından en aza indirildi
Muito obrigado, salvou meu trabalho, ab não tinha en iyi fikir. Muito obrigado mesmo!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,
Rica ederim. Yardımcı olmasına sevindim. Herhangi bir sorunuz, lütfen bizimle iletişime geçmekten çekinmeyin. İyi günler.
En içten dileklerimizle,
Mandy
Bu yorum sitedeki moderatör tarafından en aza indirildi
bana bu şekilde sütun nasıl ekleneceğini söyler misin, kod nedir
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba arkadaş,
Bu VBA kodunu kullanabilirsiniz:

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


En içten dileklerimizle,
Mandy
Bu yorum sitedeki moderatör tarafından en aza indirildi
Вот выручили так выручили!
Сидел, ломал голову как добавить строки по заданному количеству.
Birkaç gün önce.
5 üzerinden 5 olarak derecelendirildi
Bu yorum sitedeki moderatör tarafından en aza indirildi
İsim E-posta Telefon Adresi
0 İsim E-posta Telefon Adresi
adres satırı 2 İsim Telefon 0
Ad E-posta Telefon Adresi
0 İsim E-posta Telefon Adresi
adres satırı 2 0


0'lı telefon numaraları yeni bir satır başlatmadan her boş değerde veya 0 değerinde yeni bir satır başlatmak için bunu nasıl düzenleyebilirim?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, Jarrod

Üzgünüm, sorununuzu net bir şekilde anlayamıyorum.
Sorununuzu daha detaylı anlatabilir misiniz? Veya buraya bir ekran görüntüsü veya dosya ekleyebilirsiniz.
Teşekkür ederim!
Bu yorum sitedeki moderatör tarafından en aza indirildi
hola, hay algun codigo bana verileri kopyalamama izin veriyor, bu da birincil sütunda son olarak ardışık olarak pueda olabilir.

örnek

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

teşekkürler
Bu yorum sitedeki moderatör tarafından en aza indirildi
hola, hay algun codigo bana verileri kopyalamama izin veriyor, bu da son sütunların ardı ardına gelmesine neden oluyor.

örnek

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

teşekkürler
Bu yorum sitedeki moderatör tarafından en aza indirildi
Muhteşem vba betiği!
Aralarına yeni satırlar eklemem gereken 5000'den fazla satırım vardı. Diğer tüm kılavuzlar bana "yardımcı" sütunu yapmamı, sadece yeni satırlar eklemek için tekrar tekrar 1,2 kopyala yapıştır eklemenin hayatımın büyük bir bölümünü alacağını söyledi.
Bunun için teşekkürler!
5 üzerinden 5 olarak derecelendirildi
Buraya henüz hiç yorum yapılmamış
Lütfen yorum yazın
Misafir olarak yayınlama
×
Bu gönderiyi değerlendirin:
0   Karakterler
Önerilen Konumlar

Bizi takip et

Telif Hakkı © 2009 - www.extendoffice.com. | Tüm hakları Saklıdır. Tarafından desteklenmektedir ExtendOffice. | | | Site Haritası
Microsoft ve Office logosu, Microsoft Corporation'ın Amerika Birleşik Devletleri ve / veya diğer ülkelerdeki ticari markaları veya tescilli ticari markalarıdır.
Sectigo SSL ile korunmaktadır