Sütuna hücre ekleyerek kaydırmak

[erostoreus]

İlk hali Sayfa ikideki gibi olan değerleri B1, C1, D1 sütunlarına girilen değere bağlı olarak sayfa birdeki gibi bir kaydırmaya tabi tutmak istiyorum. Excel fonksiyonlarından kaydır Fonksiyonunu kullanmaya çalıştım ama başarılı olamadım. Yardımlarınız ve önerileriniz için şimdiden teşekkür ederim.

 

[Levent Menteşoğlu]

Aşağıdaki kodu sayfanın kod sayfasına kopyalayın. B1,C1 ve D1 hücrelerine sayı girdiğinizde kod kendiliğinden çalışacaktır.

[vb:1:b90090355a]Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b1:d1]) Is Nothing Then Exit Sub
For a = 1 To Target - 1
Cells(3, Target.Column).Insert
Next
End Sub[/vb:1:b90090355a]

 

[erostoreus]

Ã?ncelikle teşekkür ederim. Kodu denedim. Referans aldığı hücrede kaç yazıyorsa o kadar aşağıya kaydırıyor. Diyelim ki 3 yazdık 3 hücre kaydırıyor sonra vazgeçtik 5 yazdık son kaydırmadan sonraki halinden 5 hücre daha kaydırıyor. Sanırım ben yanlış anlattım öğrenmek istediğimi; öğrenmek istediğim 3 yazdığınızda ilk halinden 3, 5 yazdığınızda 5 ,55 yazdığınızda ilk halinden 55 hücre kaydırması.

 

[Levent Menteşoğlu]

Bu durumda aşağıdaki kodu deneyin.

[vb:1:69db265c3f]Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b1:d1]) Is Nothing Then Exit Sub
deg = Cells(2, Target.Column).End(xlDown).Row - 5
For a = 1 To target-deg
Cells(3, Target.Column).Insert
Next
End Sub
[/vb:1:69db265c3f]

 

[erostoreus]

Bu kod ile de olmadı. Sayı silsilesi Standart olarak her sütunun Beşinci satırından başlıyor. Mesela C sütünunu baz alırsak Giriş zamanı olarak 2 dersek 5+2 C7 den; 13 dersek 5+13 C18 den ;başlaması gerekiyor sütun yerleştirmeye. Tekrar 2 dersek 5+2 C7 den tekrar yerleştirmesini sağlamaya çalışıyorum.


Moderatörümüz bu problemimi aşağıdaki cevap ile çözmüştür.


[vb:1:a2e2b2964a]Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b1:d1]) Is Nothing Then Exit Sub
deg = Cells(2, Target.Column).End(xlDown).Row - 4
son = Target - deg
If son < 0 Then son = deg - Target
For a = 1 To son
If Target - deg > 0 Then Cells(3, Target.Column).Insert
If Target - deg < 0 Then Cells(3, Target.Column).Delete
Next
End Sub[/vb:1:a2e2b2964a]