Girilen sayıyı yan hücrede sürekli toplama

[bilaltaskin99]

Selamlar arkadaşlar.

A1'den A6'ya kadar toplam kutularımız ve B1'den B6'ya kadar yine sayı girmek için hücrelerimiz var.Girdiğimiz sayıyı yan hücresine sürekli olarak ekleyen bir makro ihtiyacım var.Yardımcı olur musunuz.Tek bir hücre için yapabiliyorum.Ama 6 hücreye yayamıyorum bunu.


Örnek veriyorum Ömer Bey;
B1 hücresine 70 girdik ve entere bastık A1 hücresinde 70 yazmalı.Arkasından tekrar B1 hücresine 40 gibi bi sayı girdik bu sefer A1 hücresi 110 olacak.Yani sürekli olarak B1 hücresine girilip enter'a basıldıkça bu sayıyı A1 hücresine ekleyecek.Aynı durum diğer 5 hücre için de geçerli.B2 hücresi her seferinde içine girilen sayıyı A2 hücresine,B3 hücresi A3'e gibi...

Teşekkür ediyorum Ömer Bey şimdiden.

Yardımlarınız için teşekkürler.

 

[Ömer]

Merhaba,

Soruyu açmanızı rica ederim. Yan hücre demişsiniz, B1 in yan hücresi hangisi, C1 'in yan hücresi hangisi?
Sorularınızı detaylı açıklamaya özen gösteriniz.

.

 

[bilaltaskin99]

Düzenlendi Ömer Bey.

 

[ZorBey_]

Denermisiniz.
http://s2.dosya.tc/server/lHd40A/Toplam.rar.html

 

[vardar07]

Sayfanın kod bölümüne ekleyip denermisiniz.
Zor bey dakika farkıyla cevap vermiş.Alternatif olsun.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B1:B6")) Is Nothing Then Exit Sub
Cells(Target.Row, 1) = Cells(Target.Row, 1) + Cells(Target.Row, 2)
End Sub

 

[turist]

Alternatif (2)

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [B1:B6]) Is Nothing Then Exit Sub
Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + Target.Value
End Sub

 

[bilaltaskin99]

Çok teşekkür ediyorum arkadaşlar.

 

[darkpast]

Selamlar bu konu hakkında bir sorum vardı. ben bu kodu VBS oalrak ekledim ve çok iyi şekilde çalışyor E21:E23 arasına girdiğim sayıları bir sola ekliyor çok iyi., fakat aynı sayfada F23:25 e girdiklerimi de sağdaki hücreye eklemek istiyorum. aynı kodu hücre isimlerini değiştirip (eksi işaretlerini + yapıp) denediğimde oluyor. fakat 2 farklı kod çalıştıramıyorum ya ilki yada ikinciyi seçmem gerekiyor. aynı satırda nasıl yazabilirim bunu ?

 

[jupiter00]

Peki hücreler dikey değil de yatay olsaydı? Örneğin görseldeki gibi, H4 hücresine girilen değeri B4 hücresinde toplasın, H5'e girilen değeri B5, K4'e girilen değeri E4'te nasıl toplayabilir?

 

[jupiter00]

Aşağıdaki kodu girdiğimde istediğim gibi H5 hücresine girilen her değer B5 hücresine ekleniyor ama bunu diğer hücrelere uyarlayamadım. Daha doğrusu kodu genişletemedim, hata veriyor. H5-B5 arasındaki bağı I5 ve C5 arasında da yapmak istiyorum ama aşağıdaki kodu nasıl genişletebilirim ?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("h5")) Is Nothing Then Exit Sub
[b5] = [b5] + [h5]
End Sub

 

[ÖmerBey]

Merhaba,
Deneyiniz...

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("H4:L5")) Is Nothing Then Exit Sub
Target.Offset(0, -6).Value = Target.Offset(0, -6).Value + Target.Value
End Sub

 

[jupiter00]

Merhaba,
Deneyiniz...

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("H4:L5")) Is Nothing Then Exit Sub
Target.Offset(0, -6).Value = Target.Offset(0, -6).Value + Target.Value
End Sub

Çok teşekkürler

 

[jupiter00]

Bu arada kopyala yapıştır yapıldığında hata veriyor run time error 13 hatası, neyse sorun değil, tek tek veri girdiğimde çalışıyor sonuçta.

 

[ÖmerBey]

Toplu düzenleme yapabilmek için aşağıdaki şekilde deneyebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("H4:L5")) Is Nothing Then Exit Sub
For Each hcr In Intersect(Target, Range("H4:L5")).Cells
    If IsNumeric(hcr.Value) Then hcr.Offset(0, -6).Value = hcr.Offset(0, -6).Value + hcr.Value
Next
End Sub

 

[mavi674]

Selam
Benim isteğimde ENTER'a basınca imleç sabit kalsın
yani B1 rakam girip ENTER yaptığında imleç yine B1 de kalsın
Teşekkürlerrr

 

[ÖmerBey]

B1 rakam girip ENTER yaptığında imleç yine B1 de kalsın

Merhaba,
Deneyiniz...

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B1")) Is Nothing Then
    Target.Select
End If
End Sub

 

[mavi674]

Pardon ben eksik yazmışım

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

If Intersect(Target, [B1:B6]) Is Nothing Then Exit Sub

Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + Target.Value

End Sub yukarıda yazılan bu toplama makrosunda imleç B1:B6

arasında nerede rakam giriyorsa imleç o hücrede kalsın yukarıda yazdığım B1 örnekti, bu B6 da olabilir.
Yani toplama yaptığımda imleç aşağı inmesin ki ara vermeden toplama yapabilelim...,
Teşekkürler...

 

[Korhan Ayhan]

End Sub yazan satırın üstüne Target.Select ekleyip deneyiniz.

 

[mavi674]

Tamamdır
çok teşekkür ederim...