A1 hücresine girilen değeri sürekli B1 hücresine toplama

[trn87]

Sadece A1 hücresine her seferinde farklı girilen sayıları B1 hücresinde toplamını nasıl yapabilirim??:yardim: :yardim: :???:

 

[Korhan Ayhan]

Selamlar,

ARAÇLAR-SEÇENEKLER-HESAPLAMA menüsünü açın. Yineleme seçeneğini işaretleyin. En fazla yineleme kutucuğuna 1 değerini yazıp tamam deyin.

Daha sonra B1 hücresine =A1+B1 formülünü yazın. A1 hücresine değer girip deneyin.

 

[N.Ziya Hiçdurmaz]

yanıt

Sayfa kod bölümüne kopyalayınız.

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

 

[Mdemir63]

Selamlar,

ARAÇLAR-SEÇENEKLER-HESAPLAMA menüsünü açın. Yineleme seçeneğini işaretleyin. En fazla yineleme kutucuğuna 1 değerini yazıp tamam deyin.

Daha sonra B1 hücresine =A1+B1 formülünü yazın. A1 hücresine değer girip deneyin.

Hocam selamlar,

Bence bir problem var çünkü A1 hücresindeki sayıyı dosya her açılış ve kapanışta artı kaydet denildiğinde üstüne topluyor. Tamam zaten üstüne toplayacak ama bir defa toplayacak bu formülle A1 hücresinden rakmı silmediğimz müddetçe toplama yapıyor. Buna bir çözüm üretebilirsek çok iyi olur çünkü böyle bir soru ben de sormuştum ama tatmin edici bir cevap alamadım.

Saygılar hocam

 

[Korhan Ayhan]

Selamlar,

Sn. komutan63,

Bu problemi şu şekilde aşabilirsiniz.

Araçlar-Seçenekler-Hesaplama menüsünü açın. Hesaplama seçeneğini "El ile" moduna ayarlayın. "Kaydetmeden yeniden hesapla" seçeneğini pasif hale getirin. Bu şekilde A1 hücresine değer yazdıktan sonra F9 tuşuna basarsanız istediğiniz sonuca ulaşırsınız.

Eğer bu yöntemi sağlıklı bulmazsanız Sn. V.Basic For Applications beyin sunduğu makrolu çözümü kullanmanızı öneririm.

 

[Mdemir63]

Teşekkürler hocam

İyi geceler

 

[hyr001]

Sayfa kod bölümüne kopyalayınız.

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

Merhabalar,

Bu kodu birden fazla satırda uygulama istiyorum. Mesela 1. satırdan sonra 2,3,4,.... satırlara uygulama için kodu nasıl değiştirmem gerekiyor ?

 

[Ömer BARAN]

......Bu kodu birden fazla satırda uygulama istiyorum. Mesela 1. satırdan sonra 2,3,4,.... satırlara uygulama için kodu nasıl değiştirmem gerekiyor ?

Sayfanın kod bölümüne aşağıdaki KOD'u yapıştırın.
(alt taraftan sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçtiğinizde açılan ekranın sağ tarafındaki boş alana)

[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If IsNumeric(Target) Then
        Cells(Target.Row, 2) = Cells(Target.Row, 2) + Target
    End If
[B]End Sub[/B]

 

[hyr001]

Sayfanın kod bölümüne aşağıdaki KOD'u yapıştırın.
(alt taraftan sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçtiğinizde açılan ekranın sağ tarafındaki boş alana)

[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If IsNumeric(Target) Then
        Cells(Target.Row, 2) = Cells(Target.Row, 2) + Target
    End If
[B]End Sub[/B]

Çok teşekkürler, bu haliyle çalıştı. Ancak ben tablomda bazı değişiklikler yapmıştım. Bu kodun aynı sayfa içinde hem a sütununda hem de d sütununda çalışmasını istiyorum. Bu durumda nasıl olmalı kod ?

Şimdiden teşekkürler.

 

[hyr001]

Selamlar,

Formülle yapmanın herhangi bir yolu var mı ?

 

[ahmethamit]

Sayfa kod bölümüne kopyalayınız.

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

Merhabalar,
İlgili koda c2 ve d2 hücrelerinin aynı şekilde toplandığı kodu nasıl ekleriz.

 

[clknht]

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

Bu Makro A1 hücresinde yazılan rakamı B1 hücresinde topluyor. Fakat benim istediğim A:A sütunundakileri B:B sütununda toplaması, D: D sütunundakileri E:E sütununda, G:G sütunundakileri H:H sütununda toplaması vs. gibi bir Makro nasıl olur?
Acil yardım bekliyorum. Şimdiden yardımcı olacak herkese teşekkür ederim.

 

[clknht]

Sayfanın kod bölümüne aşağıdaki KOD'u yapıştırın.
(alt taraftan sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçtiğinizde açılan ekranın sağ tarafındaki boş alana)

[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If IsNumeric(Target) Then
        Cells(Target.Row, 2) = Cells(Target.Row, 2) + Target
    End If
[B]End Sub[/B]

Ömer BARAN hocam bir sütun için yapmış.
Talebim Makronun çoklu sütunlarda aynı işlemi yapabilir olması.
Yardımlarınız için şimdiden teşekkür ederim.

 

[turist]

A:A,G:G,I:I....vb şeklinde istediğiniz kolonları belirtip değiştirebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:A,D:D,G:G")) Is Nothing Then Exit Sub
    If IsNumeric(Target) Then
        Cells(Target.Row, Target.Column + 1) = Cells(Target.Row, Target.Column + 1) + Target
    End If
End Sub

 

[clknht]

Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("A:A,D,G:G")) Is Nothing Then Exit Sub If IsNumeric(Target) Then Cells(Target.Row, Target.Column + 1) = Cells(Target.Row, Target.Column + 1) + Target End If End Sub

turist harikasın.
Çok ama çok teşekkür ederim.
Duacınım, dualarımdasın.

 

[turist]

turist harikasın.
Çok ama çok teşekkür ederim.
Duacınım, dualarımdasın.

Sağ olasın.

 

[clknht]

A:A,G:G,I:I....vb şeklinde istediğiniz kolonları belirtip değiştirebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:A,D:D,G:G")) Is Nothing Then Exit Sub
    If IsNumeric(Target) Then
        Cells(Target.Row, Target.Column + 1) = Cells(Target.Row, Target.Column + 1) + Target
    End If
End Sub

Bunu tüm sayfalarda çalışsın şekline dönüştürebilirmiyiz acaba ?

 

[turist]

Sayfa koduna değil, BuÇalışmaKitabı(ThisWorkBook) kısmına ekleyerek deneyin.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Range("A:A,D:D,G:G")) Is Nothing Then Exit Sub
    If IsNumeric(Target) Then
        Cells(Target.Row, Target.Column + 1) = Cells(Target.Row, Target.Column + 1) + Target
    End If
End Sub

 

[clknht]

Sayfa koduna değil, BuÇalışmaKitabı(ThisWorkBook) kısmına ekleyerek deneyin.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Range("A:A,D:D,G:G")) Is Nothing Then Exit Sub
    If IsNumeric(Target) Then
        Cells(Target.Row, Target.Column + 1) = Cells(Target.Row, Target.Column + 1) + Target
    End If
End Sub

Tekrar teşekkür ederim. Makro bilgim yok denecek kadar az, formüllerlede zor oluyor. Burda beklentilerimi karşılayacak örnek görünce destek isteme ihtiyacı duydum.
Desteklerinden ötürü çok teşekkür ederim. Eline, bilgine, zihnine sağlık.
Yardım edebilen insan güzel insandır. Belliki güzel insansın.
Sağlıklı ve huzurlu bir yaşam dilerim her ne kadar tanımasamda Güzel İnsana...

 

[turist]

Teşekkür ederim.