Satır eklemek

[gundoganmusa]

Merhabalar,

excelde her 2 satırdan sonra 3 satır ekleme nasıl yaparım,
1 1.satır
2 2.satır
3 1.eklenen
4 2.eklemen
5 3.eklenen
6 3.satır

yapmak istediğim tabi listem uzun
Teşekkürler

 

[hamitcan]

Chatgpt...
excelde her 2 satırdan sonra 3 satır ekleme nasıl yaparım,

ChatGPT:
Excel'de her 2 satırdan sonra 3 satır eklemek için aşağıdaki adımları izleyebilirsiniz:

1. Yeni Satırları Manuel Ekleyerek Yapma:
   • Excel dosyanızda ekleme yapacağınız hücreyi seçin.
   • İlk başta 2 satırın sonrasını seçin (örneğin, 2. satırın altındaki 3. satırı).
   • Sağ tıklayın ve "Ekle" seçeneğini seçin.
   • 3 satır eklemek için bu işlemi 2 satırda bir tekrar edin. Excel, her defasında yeni satırları ekleyecektir.
2. Makro ile Otomatik Ekleme: Eğer her 2 satırdan sonra 3 satır eklemeyi sürekli yapacaksanız, VBA (Visual Basic for Applications) kullanarak bunu otomatikleştirebilirsiniz.

Aşağıda, her 2 satırdan sonra 3 satır ekleyecek bir VBA kodu örneği bulabilirsiniz:

1. Excel dosyanızı açın.
2. Alt + F11 tuşlarına basarak VBA editorüne girin.
3. Menüden Insert > Module seçeneğini tıklayın.
4. Aşağıdaki kodu kopyalayın ve yeni modüle yapıştırın:

vba
KopyalaDüzenle
Sub SatirEkle()
Dim i As Long
Dim satirSayisi As Long

' Aktif sayfadaki toplam satır sayısını al
satirSayisi = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

' Her 2 satırda bir 3 satır ekle
For i = satirSayisi To 1 Step -2
Rows(i + 1 & ":" & i + 3).Insert Shift:=xlDown
Next i
End Sub

1. Kodunuzu çalıştırmak için F5 tuşuna basabilirsiniz.

Bu kod, aktif çalışma sayfasındaki mevcut verilere göre, her 2 satırda bir 3 yeni satır ekler.

 

[muhasebeciyiz]

Sub HerIkiSatirdanSonraUcSatirEkle()
Dim i As Long
Dim LastRow As Long

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = LastRow To 2 Step -2
Rows(i + 1 & ":" & i + 3).Insert
Next i
End Sub

 

[Necdet]

Merhaba,
Dosyadaki B sütunundaki formülü inceleyin.
B1 deki formülü A sütunundaki satır sayısı kadar uzatın.
Sonra B sütununda tüm formüllerden kurtarın.
B sütununu kopyalayın ve bunu 3 kere tekrarlayın (3 satır boşluk olacağı için)
Sonra A ve B sütununu B sütununa göre sıralatın.
B sütununu silin.

 

[Necdet]

Benim önerim de alternatif olsun, ben yazarken yanıtlar gelmiş

 

[gundoganmusa]

Sub HerIkiSatirdanSonraUcSatirEkle()
Dim i As Long
Dim LastRow As Long

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = LastRow To 2 Step -2
Rows(i + 1 & ":" & i + 3).Insert
Next i
End Sub

Denedim ama sonuç vermedi

 

[gundoganmusa]

Merhaba,
Dosyadaki B sütunundaki formülü inceleyin.
B1 deki formülü A sütunundaki satır sayısı kadar uzatın.
Sonra B sütununda tüm formüllerden kurtarın.
B sütununu kopyalayın ve bunu 3 kere tekrarlayın (3 satır boşluk olacağı için)
Sonra A ve B sütununu B sütununa göre sıralatın.
B sütununu silin.

Hocam anlamadım maalesef,
93 satırım var

 

[Necdet]

Hocam anlamadım maalesef,
93 satırım var

Gönderdiğim dosyada B sütunundaki formülü yazacaksınız. bunu a sütunundaki veri kadar uzatacaksınız.
Sonra B sütununu kopyalayıp değer olarak yapıştıracaksınız.
Sonra B sütununu kopyalayıp b sütununun altına 2 kere yapıştıracaksınız.
Örnek dosyada H ve I gibi olacak.
sonra B sütununa göre sıralama yapacaksınız.
Yani B sütunu dosyadaki I sütunu gibi olacak.

 

[Necdet]

Aşağıdaki linki inceleyiniz.
Ben bunu sizin isteğinize göre uyarladım.

İzleyiniz

 

[gundoganmusa]

Aşağıdaki linki inceleyiniz.
Ben bunu sizin isteğinize göre uyarladım.

İzleyiniz

Hocam her satır altına bir satır ekliyor

 

[Necdet]

Hocam her satır altına bir satır ekliyor

video öyle, onu ben sizin isteğinize göre uyarladım, mesajımı dikkatli okuyun.

 

[gundoganmusa]

video öyle, onu ben sizin isteğinize göre uyarladım, mesajımı dikkatli okuyun.

Hocam mesajınızı video yorumlarında yada her hangi bi yerde bulamadım

 

[gundoganmusa]

Deneyip sonucu paylaşabilir misiniz;

Sub HerIkiSatirdanSonraUcSatirEkle()
    Dim i As Long
    Dim LastRow As Long
   
    Application.ScreenUpdating = False
   
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
   
    For i = LastRow To 3 Step -2
        Rows(i + 1).Resize(3).Insert Shift:=xlDown
    Next i
   
    Application.ScreenUpdating = True
End Sub

Hocam denedim hata mesajı vermedi ama sayfada değişiklik yapmadı

 

[gundoganmusa]

Şöyle

Sub HerIkiSatirdanSonraUcSatirEkle()
    Dim i As Long
    Dim LastRow As Long
    Dim EklenenSatir As Long
   
    Application.ScreenUpdating = False
   
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    EklenenSatir = 0
   
    For i = LastRow To 1 Step -2
        If i + EklenenSatir > 2 Then
            Rows(i + EklenenSatir + 1).Resize(3).Insert Shift:=xlDown
            EklenenSatir = EklenenSatir + 3
        End If
    Next i
   
    Application.ScreenUpdating = True
   
    MsgBox "İşlem tamamlandı!", vbInformation
End Sub

ya da şöyle dener misiniz;

Sub HerIkiSatirdanSonraUcSatirEkle2()
    Dim i As Long
    Dim LastRow As Long
    Dim SatirSayaci As Long
   
    Application.ScreenUpdating = False
   
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    SatirSayaci = 0
   
    i = 1
    Do While i <= LastRow + SatirSayaci
        SatirSayaci = SatirSayaci + 1
       
        If SatirSayaci = 2 Then
            Rows(i + 1).Resize(3).Insert Shift:=xlDown
            i = i + 3
            LastRow = LastRow + 3
            SatirSayaci = 0
        End If
       
        i = i + 1
    Loop
   
    Application.ScreenUpdating = True
   
    MsgBox "İşlem tamamlandı!", vbInformation
End Sub

Hocam bu kod 2. satırın altına 3 boş satır ekledi gerisini yapmadı,

Birde örnek olarak "5. satırdan başla 170. satıra kadar" diye belirleye bilirmiyim
teşekkürler

 

[gundoganmusa]

Evet belirleyebilirsiniz hocam;

Sub HerIkiSatirdanSonraUcSatirEkle()
    Dim i As Long
    Dim BaslangicSatiri As Long
    Dim BitisSatiri As Long
    Dim EklenenSatirSayisi As Long
   
    Application.ScreenUpdating = False
    BaslangicSatiri = 5  
    BitisSatiri = 170    
    EklenenSatirSayisi = 0
   
    i = BitisSatiri
   
    Do While i >= BaslangicSatiri
        If (i - BaslangicSatiri + 1) Mod 2 = 0 Then
            Rows(i + EklenenSatirSayisi + 1).Resize(3).Insert Shift:=xlDown
            EklenenSatirSayisi = EklenenSatirSayisi + 3
            i = i - 2
        Else
            i = i - 1
        End If
    Loop
   
    Application.ScreenUpdating = True
   
    MsgBox "İşlem tamamlandı! Toplam " & EklenenSatirSayisi & " satır eklendi.", vbInformation
End Sub

Hocam seni çok uğraştırdım kusura bakma çalışmadı buda
Bende bir yandan verdiğiniz fikirlerle yapay zekayla denedim sonunda oldu,

DeepSeek

Sub SatirEkle()
Dim i As Long
Dim baslangicSatir As Long
Dim bitisSatir As Long

' Sadece 20-100 arasındaki satırlara uygula:
baslangicSatir = 4
bitisSatir = 75

' B sütununda en son dolu satırı kontrol et (opsiyonel, sınırlama için)
Dim sonDoluSatir As Long
sonDoluSatir = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

' Bitiş satırı, son dolu satırdan küçükse ayarla
If bitisSatir > sonDoluSatir Then bitisSatir = sonDoluSatir

' Tersten döngü (150'den 5'e kadar, 2'şer adımla)
For i = bitisSatir To baslangicSatir Step -2
' 3 boş satır ekle (i+1'den i+3'e kadar)
Rows(i + 1 & ":" & i + 3).Insert Shift:=xlDown
Next i
End Sub

 

[Necdet]

Merhaba, Dener misiniz.
1. satırda başlık olduğunu varsayarak kodu ona göre düzenledim.
Eğer başlık yoksa i=4 değil i=3 olarak kodda değişiklik yapınız.

Sub ekle()

Dim i As Long
Dim a As Integer
Dim b As Integer
Dim j As Long

a = 2
b = 5
i = 4

Do
    j = i + a
    Rows(i & ":" & j).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    i = i + b
Loop Until Cells(i, "A") = ""

End Sub