Hücreye yazdığım sayıyı otomatik toplatma ama diğer stünlarada

[yaramaz_31]

Mrb. Üstadlarım Aşağıdaki formülü siteden buldum. İşimi gördü fakat bu förmülle sadece A1 Hücresinde toplama yapabiliyorum. Ama ben aynı zamanda A2-A3-A4 vs. B1-B2-B3 vs. orada aynı işlemleri yapmasını istiyorum. Bunun çözümü hakkında bilgisi olan arkadaşlarımdan yardımcı olmasını rica ediyorum. Şimdiden teşekkür ederim...

Kod:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Static dAccumulator As Double
With Target
If .Address(False, False) = "A1" Then
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
dAccumulator = dAccumulator + .Value
Else
dAccumulator = 0
End If
Application.EnableEvents = False
.Value = dAccumulator
Application.EnableEvents = True
End If
End With
End Sub

 

[İhsan Tank]

Mrb. Üstadlarım Aşağıdaki formülü siteden buldum. İşimi gördü fakat bu förmülle sadece A1 Hücresinde toplama yapabiliyorum. Ama ben aynı zamanda A2-A3-A4 vs. B1-B2-B3 vs. orada aynı işlemleri yapmasını istiyorum. Bunun çözümü hakkında bilgisi olan arkadaşlarımdan yardımcı olmasını rica ediyorum. Şimdiden teşekkür ederim...

Kod:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Static dAccumulator As Double
With Target
If .Address(False, False) = "A1" Then
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
dAccumulator = dAccumulator + .Value
Else
dAccumulator = 0
End If
Application.EnableEvents = False
.Value = dAccumulator
Application.EnableEvents = True
End If
End With
End Sub

Merhaba
Sayfanın kod bölümüne kopyalayın ve deneyin.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B1:B4")) Is Nothing Then Exit Sub
Cells(Target.Row, "A") = Cells(Target.Row, "A") + Target
End Sub

 

[yaramaz_31]

Merhaba
Sayfanın kod bölümüne kopyalayın ve deneyin.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B1:B4")) Is Nothing Then Exit Sub
Cells(Target.Row, "A") = Cells(Target.Row, "A") + Target
End Sub

Yardımın için sağol kardeşim. Bu formülde işimi görebilir ama benim asıl istediğim aynı hücre içerisinde rakamı yazıp ve her yeni rakam eklediğimde toplmasını istiyorum. BU olayı benim bulduğum formülde yapabiliyorum ama sadece A1 hücresinde oluyor. Ben A1 harıcinde benim belirticeğim birden fazla hücredede aynı işlemi yapmasını istiyorum Örneğin: B1- C1-D1 gibi.

 

[İhsan Tank]

Yardımın için sağol kardeşim. Bu formülde işimi görebilir ama benim asıl istediğim aynı hücre içerisinde rakamı yazıp ve her yeni rakam eklediğimde toplmasını istiyorum. BU olayı benim bulduğum formülde yapabiliyorum ama sadece A1 hücresinde oluyor. Ben A1 harıcinde benim belirticeğim birden fazla hücredede aynı işlemi yapmasını istiyorum Örneğin: B1- C1-D1 gibi.

Merhaba
Bununla değiştirin lütfen

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Static dAccumulator As Double
With Target
If Intersect(Target, Range("A1:D1")) Is Nothing Then Exit Sub
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
dAccumulator = dAccumulator + .Value
Else
dAccumulator = 0
End If
Application.EnableEvents = False
.Value = dAccumulator
Application.EnableEvents = True
End With
End Sub

 

[yaramaz_31]

Merhaba
Bununla değiştirin lütfen

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Static dAccumulator As Double
With Target
If Intersect(Target, Range("A1:D1")) Is Nothing Then Exit Sub
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
dAccumulator = dAccumulator + .Value
Else
dAccumulator = 0
End If
Application.EnableEvents = False
.Value = dAccumulator
Application.EnableEvents = True
End With
End Sub

Hocam ilgin ve alakan için çok teşekkür ederim. Sanırım ben anlatamadım yine. Şuan sizin yaptığınız formülde A1-D1 arasında bir köprü var. Yani ben A1 e 1 yazıyorum daha sonra B1 e 1 yazdığımda A1 deki sayıyı alıp topluyarak B1 2 oluyor. Benim isteğim ise her hücre birbirinden bağımsız olmalı.Formülde benim belirlediğim hücreler örneğin A1, C1, H1,K5, buna benzer farklı hücreler birbirlerinden bağımsız olarak kendi içerisinde girdiğim veriyi aynı hücrede arttırarak toplaması. Anladığım kadarıyla siz bu işte gayet uzmansınız bunuda çözebileceğinizden eminim. Bilgisayarımın başında sizden gelicek formülü bekliyorum Tekrardan çok teşekkür ediyorum.

 

[Skorpiyon]

Sayın yaramaz_31,
Kodunuza aşağıdaki satırları ekleyin. Hücre adreslerini kendinize göre ayarlayın.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Static a As Double
With Target
If .Address(False, False) = "A1" Then 'A1 için istediğinizi yapıyorsa,
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
a = a + .Value
Else
a = 0
End If
Application.EnableEvents = False
.Value = a
Application.EnableEvents = True
End If

If .Address(False, False) = "B1" Then 'B1 için istediğinizi yapar,
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
a = a + .Value
Else
a = 0
End If
Application.EnableEvents = False
.Value = a
Application.EnableEvents = True
End If

If .Address(False, False) = "A3" Then 'A3 için istediğinizi yapar,
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
a = a + .Value
Else
a = 0
End If
Application.EnableEvents = False
.Value = a
Application.EnableEvents = True
End If
End With
End Sub

 

[yaramaz_31]

Sayın yaramaz_31,
Kodunuza aşağıdaki satırları ekleyin. Hücre adreslerini kendinize göre ayarlayın.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Static a As Double
With Target
If .Address(False, False) = "A1" Then 'A1 için istediğinizi yapıyorsa,
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
a = a + .Value
Else
a = 0
End If
Application.EnableEvents = False
.Value = a
Application.EnableEvents = True
End If

If .Address(False, False) = "B1" Then 'B1 için istediğinizi yapar,
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
a = a + .Value
Else
a = 0
End If
Application.EnableEvents = False
.Value = a
Application.EnableEvents = True
End If

If .Address(False, False) = "A3" Then 'A3 için istediğinizi yapar,
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
a = a + .Value
Else
a = 0
End If
Application.EnableEvents = False
.Value = a
Application.EnableEvents = True
End If
End With
End Sub

Üstadım ilgin ve alakan için tşk. ederim. Fakat bu formülde işimi görmüyor. İstediğim Formül şöyle olmalı: A1 - B1 - A5 -K5 Bunlar ayrı birer hücre. Senin ve diğer arkadaşımın formülleri bu hücreleri birleştirerek topluyo. Ama benim istediğim hangi hücreye rakam giriyorsam diğer hücrelerden bağımsız olarak girdiğim hücrenin içerisindeki rakamın üzerine toplayarak yapmasını istiyorum. Bunu formül ilk mesajımda belirttiğim formül. Fakat ben aynı formülü işim gereği birden çok hücrelerde kullanmak istiyorum. Yani her hücre diğerlerinden bağımsız olmalı.

YARDIMLARINIZI BEKLİYORUM....

 

[Skorpiyon]

Sayın yaramaz_31,

Bunu deneyin. With - End With olayı gözden kaçmış.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Static aaa, bbb, ccc, ddd As Double
With Target
If .Address(False, False) = "A1" Then
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
aaa = aaa + .Value
Else
aaa = 0
End If
Application.EnableEvents = False
.Value = aaa
Application.EnableEvents = True
End If
End With
With Target
If .Address(False, False) = "A5" Then
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
bbb = bbb + .Value
Else
bbb = 0
End If
Application.EnableEvents = False
.Value = bbb
Application.EnableEvents = True
End If
End With
With Target
If .Address(False, False) = "B1" Then
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
ccc = ccc + .Value
Else
ccc = 0
End If
Application.EnableEvents = False
.Value = ccc
Application.EnableEvents = True
End If
End With
With Target
If .Address(False, False) = "K5" Then
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
ddd = ddd + .Value
Else
ddd = 0
End If
Application.EnableEvents = False
.Value = ddd
Application.EnableEvents = True
End If
End With
End Sub

 

[yaramaz_31]

Sayın yaramaz_31,

Bunu deneyin. With - End With olayı gözden kaçmış.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Static aaa, bbb, ccc, ddd As Double
With Target
If .Address(False, False) = "A1" Then
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
aaa = aaa + .Value
Else
aaa = 0
End If
Application.EnableEvents = False
.Value = aaa
Application.EnableEvents = True
End If
End With
With Target
If .Address(False, False) = "A5" Then
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
bbb = bbb + .Value
Else
bbb = 0
End If
Application.EnableEvents = False
.Value = bbb
Application.EnableEvents = True
End If
End With
With Target
If .Address(False, False) = "B1" Then
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
ccc = ccc + .Value
Else
ccc = 0
End If
Application.EnableEvents = False
.Value = ccc
Application.EnableEvents = True
End If
End With
With Target
If .Address(False, False) = "K5" Then
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
ddd = ddd + .Value
Else
ddd = 0
End If
Application.EnableEvents = False
.Value = ddd
Application.EnableEvents = True
End If
End With
End Sub

Tam istediğim gibi olmuş Ellerinize sağlık üstadlarım çok teşekkür ederim. Hayırlı akşamlar.

 

[yaramaz_31]

herkese selamlar arkadaşlar birde şöyle bir formüle ihtiyacım var örnek A1 ile Z90 arası hangi hücreye rakam girersem o hücrenin üzerine toplasın

 

[yaramaz_31]

lütfen arkadaşlar bana bu formül çok lazım yardımınıza ihtiyacım var ben acemiyim herkese selamlar örnek A1 ile Z90 arası hangi hücreye rakam girersem o hücrenin üzerine toplasın allah hepinizden razı olsun

 

[Skorpiyon]

Sayın yaramaz_31,

Bunu yukarıdaki koda nasıl uygularız bilemiyorum ama, alternatif olması açısından size basit bir örnek.

İnceleyin. Hücre sınırlaması yok, hangi hücrede isterseniz orada toplama yapar.

 

[yaramaz_31]

şaban bey çok çok teşekür ederim allah razı olsun çok güzel istediğim gibi yalnız ben acemiyim userform veya texbox gibi şeyleri yapmasını bilmiyorum bana bunu yalnız kod la çalışanını yaparsanız ben kendi tabloma kopyalayacağım çok uğraştım kendi tablolarıma bunu uyarlayamadım

 

[Skorpiyon]

Sayın yaramaz_31,

Özel değilse, Siz dosyanızı yollayın, biz eklemeyi yapalım. Bunun userform olmadan kod bölümü çalışmazda.

 

[yaramaz_31]

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Static dAccumulator As Double
With Target
If .Address(False, False) = "A1" Then
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
dAccumulator = dAccumulator + .Value
Else
dAccumulator = 0
End If
Application.EnableEvents = False
.Value = dAccumulator
Application.EnableEvents = True
End If
End With
End Sub

şaban bey sizden özür diliyorum tablomda özel bilgilerim var bu formülü bana çoğalta bilirseniz istediğim gibi olur A1 E sürekli topluyor bunu A1 ve Z100 aralığı gibi yapabilirseniz isteğim olacak ilginize alakanıza çok teşekür ederim olmasada ellerinize sağlık allaha emanet olun

 

[Korhan Ayhan]

Merhaba,

Sayfanıza ait eski kodların yerine aşağıdaki kodu deneyiniz.

Uygulamalı örnek dosya ektedir.

Option Explicit
Dim Eski_Veri
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("A1:Z100")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
 
    Application.EnableEvents = False
    If IsNumeric(Target) And Target <> "" Then Target = Eski_Veri + Target
    If Target = "" Then Eski_Veri = ""
Son:
    Application.EnableEvents = True
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Eski_Veri = Target.Value
End Sub

 

[yaramaz_31]

korhan bey çok çok teşekür ederim elleriniz dert görmesin inşallah tam istediğim gibi olmuş ayriyeten ilgilendiği için şaban beyede teşekür ediyorum allah hepinizden razı olsun hoşça kalın

 

[yaramaz_31]

Hatırlatma

Hepinize iyi akşamlar tablomda b 2 ile b 100 arası ödeme tarihleri c 2 ile c 100 arası ödenecek tutarlar var istediğim tablomu açtığımda ödeme günü gelenleri bir mesaj penceresinde listelemesi ve ödemesini gecirdiklerimi de yine bir mesaj penceresinde göstermesini istiyorum yardımlarınızı bekliyorum hepinizden allah razı olsun

 

[rapstar_kagan_96]

Kendi üzerine toplama

Option Explicit
Dim Eski_Veri

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, Range("A1:Z100")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub

Application.EnableEvents = False
If IsNumeric(Target) And Target <> "" Then Target = Eski_Veri + Target
If Target = "" Then Eski_Veri = ""
Son:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Eski_Veri = Target.Value
End Sub


Kodlar Korhan Hocama ait. Buna ufak bir ilave yaptırmak istiyorum. Diyelim ki A1 hücresine 5 yazıp ENTER tuşuna bastım mı ( ikinci bir rakam yazıp toplamaya olanak sağlasın diye) yine aynı hücre aktif kalsın.

 

[rapstar_kagan_96]

Sorumu güncellemek istiyorum arkadaşlar