• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

girilen değere göre satır açma

E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Kod: 
Sub coklusatırekleme()
     stns = InputBox("sütun başlangıç hücresini yaz...")
    
     strs = InputBox("satır başlangıç hücresini yaz")
    
     ks = InputBox("kaç satır eklenecek.")
    
    x = Range("" & strs & "").Row
    y = Range("" & stns & "").Column
    
    noA = Cells(x, y).End(xlUp).Row
    
    For i = x To ks Step ks - 1
        Rows(i & ":" & i + ks).Insert
    Next
End Sub
benim için büyük bilenler için küçük bir adım olacak sorum satır ve sütunu seçerek ve kaç satır ekleneceğini yazarak ilgili sütunda son satıra kadar (son satır dahil) satır eklemek istiyorum. sorun yapamıyorum sorum nasıl yapabilirim :)
 
Merhaba aşağıdaki kod ile yapabilirsiniz.

Kod: 
Sub coklusatırekleme()
    Dim SB As String
    Dim SA As String
    Dim SatirBas As Integer
    Dim SatirAdet As Integer
    SB = InputBox("Satır başlangıç hücresini yazınız.")
    If IsNumeric(SB) Then
        SatirBas = SB
    Else
        MsgBox "Lütfen geçerli bir rakam giriniz."
        Exit Sub
    End If
    SA = InputBox("Kaç satır eklemek istiyorsunuz?.")
    If IsNumeric(SA) Then
        SatirAdet = SA
    Else
        MsgBox "Lütfen geçerli bir rakam giriniz."
        Exit Sub
    End If
    Rows(SatirBas & ":" & SatirBas + SatirAdet - 1).Insert
End Sub
 
euphrates55' Alıntı:
Kod: 
Sub coklusatırekleme()
     stns = InputBox("sütun başlangıç hücresini yaz...")
   
     strs = InputBox("satır başlangıç hücresini yaz")
   
     ks = InputBox("kaç satır eklenecek.")
   
    x = Range("" & strs & "").Row
    y = Range("" & stns & "").Column
   
    noA = Cells(x, y).End(xlUp).Row
   
    For i = x To ks Step ks - 1
        Rows(i & ":" & i + ks).Insert
    Next
End Sub
benim için büyük bilenler için küçük bir adım olacak sorum satır ve sütunu seçerek ve kaç satır ekleneceğini yazarak ilgili sütunda son satıra kadar (son satır dahil) satır eklemek istiyorum. sorun yapamıyorum sorum nasıl yapabilirim :)
Genişletmek için tıkla ...



Kod: 
Sub SUT_SAT_SEC_HUCREEKLE()
'SÜTUN SATIR SEÇİP İLGİLİ SÜTUNA HÜCRE EKLE
Dim SAT As Double
Dim SAY As Double

STNS = InputBox("SÜTUN sec")
If STNS = "" Then Exit Sub

STRS = InputBox("SATIR sec")
If STNS = "" Then Exit Sub

KS = InputBox("Kaç SATIR HÜCRE eklenecek.")
If KS = "" Then Exit Sub

SAT = STRS
SAY = KS

    Range(STNS & SAT + 1 & ":" & STNS & SAT + SAY).Insert Shift:=xlDown ', CopyOrigin:=xlFormatFromLeftOrAbove
End Sub

Sub SATIREKLE()
'Satır Ekleme
Dim SAT As Double
Dim SAY As Double

STRS = InputBox("Sütun başlangıç hücresini yaz")
If STRS = "" Then Exit Sub
 
KS = InputBox("kaç SATIR eklenecek.")
If KS = "" Then Exit Sub

SAT = STRS
SAY = KS
    
Rows(SAT + 1 & ":" & SAT + SAY).Insert
End Sub

Sub SUTUNEKLE()
'Sütun Ekleme
STNS = InputBox("SÜTUN başlangıç sec")
If STNS = "" Then Exit Sub
 
KS = InputBox("kaç SÜTUN eklenecek.")
If KS = "" Then Exit Sub

For I = 1 To KS
   Columns(STNS).Insert
Next I

End Sub
 
Sub SUT_SAT_SEC_HUCREEKLE() de sadece ilk hücreye yapıyor, diğerlerine eklemiyor. sütunda da aynı
 
hımmmmmmmm' Alıntı:
sütungirişine A-B-C-D .... gibi sütun harfleri girilecek
Genişletmek için tıkla ...
doğrudur. alt alta 20 dolu satırın var ve ilk değere A yazdık 2. değere 1 yazdık. kaç satıra 5 yazdık. işlem sadece 1. satırın altına 5 boş satır ekliyor. kalan dolu hücrelerin altına eklemiyor.

2. kod Sub SATIREKLE() direk hata veriyor.

3. kod 1. maddedeki gibi yapıyor.
 
2. mesajda verdiğim kodları denediniz mi?
 
hımmmmmmmm' Alıntı:
deneme dosyası gönderiyorum
Genişletmek için tıkla ...
şimdi anladım. farklı şeylerden bahsediyoruz. sizin k, seçilen satır numarasına ekliyor. tek satır için. bense satıra 1 yazdığımda sütundaki son dolu hücreye kadar her birine istenen satır sayısı eklensin istiyorum. dolayısı ile ilk satır numarası seçildiğinde bir de son hücrenin olması gerektiği bir sütun da seçilebilmeli ve o sütundaki dolu olan her satırın altına boş hücreleri eklemeli.
 
Merhaba
Alternatif olarak
Sizin tarifinize göre şu dosyayıda denermisiniz
http://dosya.co/w2mf5nwac3pz/satır.zip.html
Kod: 
Sub coklusatırekleme()
     stns = InputBox("sütun başlangıç hücresini yaz...")
    
     strs = InputBox("satır başlangıç hücresini yaz")
    
     ks = InputBox("kaç satır eklenecek.")
If IsNumeric(stns) = True Or IsNumeric(strs) = False Or IsNumeric(ks) = False Or stns = "" Then
MsgBox "hatalı giriş"
Exit Sub
End If
  For s = 1 To ks
  If m <> Empty Then v = ","
  m = m & v & stns & strs + s
     Next

 Range(m).EntireRow.Insert
End Sub
 
sayın plint
kaç satır eklenecek dediğinde, örnek 5 dedik... başlanan yerden aşağıya 5 dolu hücreye 1 er satır ekliyor.
 
Şöyle olabilirmi?

Kod: 
Sub coklusatırekleme()
     stns = InputBox("sütun başlangıç hücresini yaz...")
    
     strs = InputBox("satır başlangıç hücresini yaz")
    
     ks = InputBox("kaç satır eklenecek.")
  
If IsNumeric(stns) = True Or IsNumeric(strs) = False Or IsNumeric(ks) = False Or stns = "" Then
MsgBox "hatalı giriş"
Exit Sub
End If
  x = Cells(Rows.Count, 1).End(3).Row

  For s = x To strs Step -1
  For i = 1 To ks
  Cells(s + 1, stns).EntireRow.Insert
Next
     Next
End Sub
 
PLİNT' Alıntı:
Şöyle olabilirmi?

Kod: 
Sub coklusatırekleme()
     stns = InputBox("sütun başlangıç hücresini yaz...")
   
     strs = InputBox("satır başlangıç hücresini yaz")
   
     ks = InputBox("kaç satır eklenecek.")
 
If IsNumeric(stns) = True Or IsNumeric(strs) = False Or IsNumeric(ks) = False Or stns = "" Then
MsgBox "hatalı giriş"
Exit Sub
End If
  x = Cells(Rows.Count, 1).End(3).Row

  For s = x To strs Step -1
  For i = 1 To ks
  Cells(s + 1, stns).EntireRow.Insert
Next
     Next
End Sub
Genişletmek için tıkla ...

evet oldu. teşekkürler
 
bir de sütun ekleme için yaparsanız burası iyi bir kaynak olarak, bir çok kullanıcı tarafından kullanılır düşüncesindeyim
 
Aşağıdaki gibi
Kod: 
Sub coklusütunekleme()
     strs = InputBox("sütun başlangıç Harf giriniz")
     ks = InputBox("kaç sütun eklenecek.")
If IsNumeric(strs) = True Or IsNumeric(ks) = False Then
MsgBox "hatalı giriş"
Exit Sub
End If

  x = Cells(1, Columns.Count).End(xlToLeft).Column
  v = Range(Trim(strs) & "1").Column
  For s = x To v Step -1
  For i = 1 To ks
     Columns(s + 1).Insert
      ' Columns(s).Insert
Next
     Next
End Sub
 
peki ya aradaki boşlukları silme, satırlar ve sütunlar için ayrı ayrı :) :)
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst