Satır eklemek

gundoganmusa · Salı saat 16:41'de

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 · Salı saat 17:09'de

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:

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.
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:

Excel dosyanızı açın.
Alt + F11 tuşlarına basarak VBA editorüne girin.
Menüden Insert > Module seçeneğini tıklayın.
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

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 · Salı saat 17:11'de

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 · Salı saat 17:28'de

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 · Salı saat 17:29'de

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

gundoganmusa · Salı saat 17:31'de

muhasebeciyiz' Alıntı:
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 · Salı saat 17:37'de

Necdet' Alıntı:
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 · Salı saat 17:45'de

gundoganmusa' Alıntı:
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 · Salı saat 17:49'de

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

İzleyiniz

gundoganmusa · Salı saat 18:10'de

Necdet' Alıntı:
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

pitchoute · Salı saat 18:10'de

Deneyip sonucu paylaşabilir misiniz;

Kod:

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

Necdet · Salı saat 19:08'de

gundoganmusa' Alıntı:
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 · Çarşamba saat 11:51'de

Necdet' Alıntı:
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 · Çarşamba saat 12:02'de

pitchoute' Alıntı:

Deneyip sonucu paylaşabilir misiniz;

Kod:

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ı

pitchoute · Çarşamba saat 14:31'de

gundoganmusa' Alıntı:
Hocam denedim hata mesajı vermedi ama sayfada değişiklik yapmadı

Şöyle

Kod:

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;

Kod:

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

gundoganmusa · Çarşamba saat 17:48'de

pitchoute' Alıntı:

Şöyle

Kod:

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;

Kod:

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

pitchoute · Çarşamba saat 18:02'de

Evet belirleyebilirsiniz hocam;

Kod:

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

gundoganmusa · Çarşamba saat 18:25'de

pitchoute' Alıntı:

Evet belirleyebilirsiniz hocam;

Kod:

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

pitchoute · Çarşamba saat 18:54'de

Estağfurullah, iyi çalışmalar.

Necdet · Çarşamba saat 23:57'de

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.

Kod:

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

Satır eklemek

gundoganmusa

hamitcan

Uzman

muhasebeciyiz

Necdet

Moderatör

Ekli dosyalar

Necdet

Moderatör

gundoganmusa

gundoganmusa

Necdet

Moderatör

Necdet

Moderatör

gundoganmusa

pitchoute

Necdet

Moderatör

gundoganmusa

gundoganmusa

pitchoute

gundoganmusa

pitchoute

gundoganmusa

pitchoute

Necdet

Moderatör