Sabit sütunda kayan sayılar

[greenfire]

Merhaba arkadaşlar,
projede yine zora düştüm ve yine sizlerin yardımına ihtiyacım var. Yapmak istediğim şu arkadaşlar:

A1'den A20'ye kadar her hücreye birbirinden farklı 20 sayı yazıldığını düşünelim. Bu A1-A20 bölgesinin sabit kalmasını ama içindeki sayıların aşağı doğru akmasını sağlamak istiyorum.

B2 hücresine bir sayı yazdığım zaman bu sayının otomatikmen A1 hücresine geçmesini ve diğer bütün sayıların bir hücre aşağı kaymasını istiyorum ama A21'e değil, dediğim gibi A1-A20 bölgesinin sabit olması gerekiyor. Böyle böyle B2'ye yazacağım her sayının tek tek A1'e yazılmasını ve her seferinde de altta kalan bütün sayıların bir hücre aşağı kayması gerekiyor. Ve B2 yani input hücresinin de her seferinde kendisini temizleyip benim gireceğim yeni sayıya hazır duruma gelmesi gerekiyor.

Bir türlü beceremedim arkadaşlar. Yardımlarınız için şimdiden teşekkür ederim

Saygılar
Emre

 

[sakman26]

selam,
eki inceleyin..
(belki böyle bir şey istenmiyordur ama fikir verebilir)
kolay gelsin...

link : http://s4.dosya.tc/server/jfkmtq/greenfire.xlsx.html

 

[sakman26]

selam,
bu örnek , sabit sütunda değil ama sabit tablo içerisinde kayan yazılara yönelik bir örnek.
Mantık yine ilk gönderilen örnekle aynı..
(farklı bir fikir verebilmek amacıyla gönderildi)

link : http://s4.dosya.tc/server/06h6k3/greenfire2.xlsx.html

 

[greenfire]

sakman hocam eline emegine saglik fakat gönderdigin iki örnekte istedigim seyden uzak. Düsündügüm seyi senin örneklerine entegre etmeye calistim, olmadi

 

[Muzaffer Ali]

Aşağıdaki kodları deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim bak As Integer
    If Target.Address = "$B$2" Then
        For bak = 20 To 2 Step -1
            Cells(bak, 1).Value = Cells(bak - 1, 1).Text
        Next
        Cells(1, 1).Value = Target.Text
    End If
End Sub

 

[turist]

Alternatif olarak; Dosyanızda, sayfanızın bulunduğu KOD kısmına:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
Range("A1:A19").Copy
Range("A2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("A1").Value = Range("b2").Value
Range("b2").Select
End If

End Sub

yazarak deneyin.

 

[greenfire]

Aşağıdaki kodları deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim bak As Integer
    If Target.Address = "$B$2" Then
        For bak = 20 To 2 Step -1
            Cells(bak, 1).Value = Cells(bak - 1, 1).Text
        Next
        Cells(1, 1).Value = Target.Text
    End If
End Sub

Alternatif olarak; Dosyanızda, sayfanızın bulunduğu KOD kısmına:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
Range("A1:A19").Copy
Range("A2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("A1").Value = Range("b2").Value
Range("b2").Select
End If

End Sub

yazarak deneyin.

Hocam, kodlarin ikisini de ekledim ama hicbir degisiklik olmadi; kodlari yanlis mi ekledim acaba? Visual Basic kilsminda yeni modüle yazdim

 

[Muzaffer Ali]

Verilerin bulunduğu sayfanın kod editörüne kopyalamanız gerekiyor.
Sayfa adını sağ tıklatıp "Kod Görüntüle" seçin açılan kod editörü sayfasına kodları kopyalayın.

"B2" hücresinde her değişiklik olduğunda kodlar çalışacaktır.
Yalnız iki kodu da kopyalarsanız hata verecektir sadece bir kodu kopyalayarak deneyin.

 

[greenfire]

Verilerin bulunduğu sayfanın kod editörüne kopyalamanız gerekiyor.
Sayfa adını sağ tıklatıp "Kod Görüntüle" seçin açılan kod editörü sayfasına kodları kopyalayın.

"B2" hücresinde her değişiklik olduğunda kodlar çalışacaktır.
Yalnız iki kodu da kopyalarsanız hata verecektir sadece bir kodu kopyalayarak deneyin.

Hocam oldu; kodlarin ikisi de calisiyor elinize emeginize saglik cok cok tesekkür ederim

Saygilar, sevgiler
Emre

 

[greenfire]

Aşağıdaki kodları deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim bak As Integer
    If Target.Address = "$B$2" Then
        For bak = 20 To 2 Step -1
            Cells(bak, 1).Value = Cells(bak - 1, 1).Text
        Next
        Cells(1, 1).Value = Target.Text
    End If
End Sub

Hocam peki A1-A20 araligini degistirmek icin bu kodda nerede degisiklik yapmam gerekiyor?
Tesekkürler

 

[YUSUF44]

Hocam peki A1-A20 araligini degistirmek icin bu kodda nerede degisiklik yapmam gerekiyor?
Tesekkürler

Koddaki

For bak = 20 To 2 Step -1

Kısmı "20'den 2'ye kadar birer azaltarak işlem yap" anlamına geliyor. Burdaki 20 ve 2'yi değiştirerek deneyin.

 

[greenfire]

Koddaki

For bak = 20 To 2 Step -1

Kısmı "20'den 2'ye kadar birer azaltarak işlem yap" anlamına geliyor. Burdaki 20 ve 2'yi değiştirerek deneyin.

Peki ya A sütununu da degistirmek istersek?

 

[YUSUF44]

Peki ya A sütununu da degistirmek istersek?

Koddaki

Cells(bak, 1)

İfadesi şu anlama geliyor: Cells hücre(ler) demektir, bu ifadeden sonra parantez içinde sırasıyla satır ve sütun bilgisi verilir. Bu durumda koddaki "bak" ifadesi satırı, 1 de sütunu belirliyor demektir. Genelde sayı olarak kullanılan bu ifadeler, sütun için harf olarak da kullanılabilir.

A sütunu 1. sütun olduğundan kodda 1 olarak kullanılmıştır. B için 2, D için 4 yazılabilir. Ya da doğrudan tırnak içinde sütunu da yazabilirsiniz:

cell(bak, "D") gibi.

 

[greenfire]

Koddaki

Cells(bak, 1)

İfadesi şu anlama geliyor: Cells hücre(ler) demektir, bu ifadeden sonra parantez içinde sırasıyla satır ve sütun bilgisi verilir. Bu durumda koddaki "bak" ifadesi satırı, 1 de sütunu belirliyor demektir. Genelde sayı olarak kullanılan bu ifadeler, sütun için harf olarak da kullanılabilir.

A sütunu 1. sütun olduğundan kodda 1 olarak kullanılmıştır. B için 2, D için 4 yazılabilir. Ya da doğrudan tırnak içinde sütunu da yazabilirsiniz:

cell(bak, "D") gibi.

Eyvallah hocam tesekkürler