hücreye girilen değeri topla

[asilme]

arkadaşlar bir sorunum var. A sütununda malzeme listesi var ve B sütununada bu malzemenin toplam sayısı giriliyor.Ancak evrak üzerinden her sayım yapıldığında B sütunundaki değer artarak gitmesi gerekiyor.B2 değeri dosya kontrolünde 2 çıkıyor diğer dosyada 3 tane daha var diğer dosyada 4 tane değer var bunları toplayarak devam etmek gerekiyor.Bu son bulduğum değerleri C sütununa yazıyorum.istediğim C ye yazdığım her değer B de toplansın.yani B 20 diyelim ben C ye 3 yazınca B 23 olacak C deki 3 yi silip 5 yazarsam B 28 olacak aşağıdaki makro ile bunu yapıyorum ancak tek satır için her seferinde butona basmam gerekiyor hücreden çıkar çıkmaz bunu nasıl yapabilirim ayrıca sayfada 100 satır var ve bu işlem her ay sıfırdan sayım yapılıyor.her seferinde kağıt kalem ile ( A1 de masa var birinci dosyada 7 tane sayıp,diğer dosyada 3 tanre diğer dosyada 2 gibi kağıda yazıp toplam rakamı B1 yazmak hem zor oluyor hemde çağ dışı ekli makro ile yapıyorum ancak tek A1 hücresi için ve her seferinde butona basmam gerekiyor daha değişik nasıl yapabilirim.

Sub topla()
a = [C1]
For i = 1 To [B1000000].End(3).Row
Cells(i, "B") = Cells(i, "B") + a
Next
MsgBox "İşlem tamam."
End Sub

yardımlarınızı bekliyorum

 

[Ömer]

Merhaba,

Çalışma sayfasının kod bölümüne kopyalayın. C sütununa değer girdiğinizde makro kendiliğinden çalışır ve istediğiniz toplamayı yapar.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
    
    With Target
        If .Value = "" Then Exit Sub
        Cells(.Row, "B") = .Value + Cells(.Row, "B")
    End With
    
End Sub

.

 

[asilme]

Merhaba,

Çalışma sayfasının kod bölümüne kopyalayın. C sütununa değer girdiğinizde makro kendiliğinden çalışır ve istediğiniz toplamayı yapar.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
    
    With Target
        If .Value = "" Then Exit Sub
        Cells(.Row, "B") = .Value + Cells(.Row, "B")
    End With
    
End Sub

.

elinize sağlık çok teşekkür ederim hakkınızı helal edin

 

[Ömer]

Rica ederim. Hakkım varsa helal olsun.

 

[asilme]

Rica ederim. Hakkım varsa helal olsun.

ömer hocam bunun aynı hücre içerisinde yapılması mümkünmü yani hem b ye yazsam hemde b deki daha önceki değerle toplamak mümkün olurmu YADA toplamını istediğim hücreye gelince bir pencere veya yer açılıp oraya yazınca direk b ye toplarmı yani aşağıya doğru her indiğimde geldiğim hücrede pencere açılıp çıkınca kapanırmı

 

[Ömer]

Aynı hücrede yapacaksanız eski kodları silip aşağıdakileri kullanın. B ye veri girdiğinizde üzerine toplar.

Dim deg As Double

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
    
    If Selection.Count > 1 Then Exit Sub
    With Target
        If Not IsEmpty(.Value) And IsNumeric(.Value) Then
            Application.EnableEvents = False
                .Value = .Value + deg
            Application.EnableEvents = True
        Else
            .Value = 0
        End If
    End With
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
    If Selection.Count > 1 Then Exit Sub
    deg = Target
    
End Sub

.

 

[asilme]

ömer hocam elinize sağlık çok güzel olmuş 2.sütunu yaptırmak için Range("B:B","C:C")) olarak yaptım çalışıyor ancak 4.sütunda yani D eklersem çalışmıyor 3,4. sütunu nasıl ekleyebilirim

 

[Ömer]

Bu şekilde deneyin.

Range("B:D")

.

 

[asilme]

Bu şekilde deneyin.

Range("B:D")

.

ömer hocam çok sağolun tekrar tekrar sorup sizi yorduğumdan dolayı hakkınızı helal edin