Tek hücrede toplama ve çıkarma işlemi yapmak

[Saban Sertkaya]

Merhabalar,

Örneğin, C10 hücresinde işlem yapmak istiyorum. Talebim şöyle bir şey;

Hücrede diyelim ki 25 rakamı var. Hücreye sayısal değer girdiğimde,
+10 diye giriş yaparsam toplayıp 35 yapsın,
-10 diye giriş yaparsam çıkararak 15 yapsın.

Hücreye yanlışlıkla metinsel bir ifade girildiğinde uyarı verirse güzel olur.
+ ve - ifadelerinden dolayı excel veri girişini metinsel algılayacaktır.
İlk karakter + ve - olacağından dolayı kod ile metinsel ifadenin önüne geçilebilir diye düşünüyorum.

Yardım için emek sarf edecekler tüm değerli forum sakinlerine şimdiden teşekkürlerimi sunarım.

 

[Ömer]

Merhaba,

Çalışma sayfasının kod bölümüne kopyalayıp deneyiniz.

Public deg As Double
Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [C10]) Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    With Target
        If IsNumeric(.Value) = False Then
            MsgBox "Sadece Sayı Girebilirsiniz", vbCritical
            .Value = deg
            Exit Sub
        End If
        .Value = .Value + deg
    End With
    Application.EnableEvents = True
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    deg = [C10]
End Sub

 

[Saban Sertkaya]

Ömer Hocam ilginiz için teşekkür ederim.
Kodlamada metinsel değer girilip hata verildikten sonra işlem yapmadığını farkettim. Kodlarınızda aşağıdaki revize işlemini yaparak sorunu çözdüm.
Tekrar teşekkür eder, çalışmalarınızda başarılar dilerim.

Public deg As Double
---------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C10]) Is Nothing Then Exit Sub
Application.EnableEvents = False
With Target
If IsNumeric(.Value) = False Then
MsgBox "Sadece Sayı Girebilirsiniz", vbCritical
.Value = deg
'Exit Sub
GoTo 10
End If
.Value = .Value + deg
End With
10
Application.EnableEvents = True
End Sub
---------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
deg = [C10]
End Sub

 

[muhsinde]

Bu sayfa üzerinden uzun bir süre geçmiş ama, benimde işime yaradı, bu kod sadece bir hücre için geçerli, birden fazla hücrede kullanmak için bu koda nasıl eklemeler yapılabilir, cevaplarsanız teşekkür ederim.

 

[ÖmerFaruk]

If Intersect(Target, [C10]) Is Nothing Then Exit Sub

Mesela
Sadece 2 hücrede, A1 ve B22 de çalışsın istiyorsanız
If Intersect(Target, Range("A1,B22") Is Nothing Then Exit Sub

E5:E15 aralığında çalışsın istiyorsanız
If Intersect(Target, Range("E5:E15") Is Nothing Then Exit Sub

Hem E5:E15 hem de G2:G8 aralığında çalışsın istiyorsanız
If Intersect(Target, Range("E5:E15, G2:G8") Is Nothing Then Exit Sub

 

[muhsinde]

ÖmerFaruk üstad yazdığınız formüller hücre aralıkları toplamında çalışıyor, Ama benim istediğim seçtiğim birden çok hücrede bağımsız olarak çalışmasıdır, yani sadece seçili hücrelerde toplama yapmalıdır, mesela apartman aylık aidatı aylık 500 lira, ilgili kişi 250 lirayı ayın 15. inde ödedi, 250 de ilgili ayın 25 inde ödedi, önce girdiğim ödemenin üzerine yazdığımda sadece ilgili kişi için o hücrede toplama işlemi yapmalıdır. Birden fazla kişi ve satır var.

 

[ÖmerFaruk]

Merhaba,
Ne sormaya çalıştığınızı örnek dosyanızı ekleyerek sorarmısınız.

 

[muhsinde]

Örnek dosyayı ekledim

 

[ÖmerFaruk]

KAYDET butonunuz olan CommandButton1 kodları içindeki mevcut satırınızı (tırnak içindeki) yeni verdiğimle değiştirin

    'Cells(sat, sut).Value = CDbl(TextBox2.Value)
    Cells(sat, sut).Value = Cells(sat, sut).Value + CDbl(TextBox2.Value)

 

[muhsinde]

ÖmerFaruk İşlem tamam üstadım, Allah gönlünüze göre versin.

 

[kerimssv]

If Intersect(Target, [C10]) Is Nothing Then Exit Sub

Mesela
Sadece 2 hücrede, A1 ve B22 de çalışsın istiyorsanız
If Intersect(Target, Range("A1,B22") Is Nothing Then Exit Sub

E5:E15 aralığında çalışsın istiyorsanız
If Intersect(Target, Range("E5:E15") Is Nothing Then Exit Sub

Hem E5:E15 hem de G2:G8 aralığında çalışsın istiyorsanız
If Intersect(Target, Range("E5:E15, G2:G8") Is Nothing Then Exit Sub

Hocam üzerinden zaman geçmiş ama bir soru sormam lazım. Dediğiniz şeyleri denedim ama olmadı. kodu B2,B17 arası her hücrede çalıştırmam lazım nasıl yapabilirim?

 

[ÖmerBey]

Merhaba,
Öncelikle foruma hoş geldiniz.
Aşağıdaki şekilde deneyiniz...

Public deg As Double
Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [B2:B17]) Is Nothing Then Exit Sub
   
    Application.EnableEvents = False
    With Target
        If IsNumeric(.Value) = False Then
            MsgBox "Sadece Sayı Girebilirsiniz", vbCritical
            .Value = deg
            Application.EnableEvents = True
            Exit Sub
        End If
        .Value = .Value + deg
    End With
    Application.EnableEvents = True
   
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, [B2:B17]) Is Nothing Then Exit Sub
    If Target.Cells.Count = 1 Then deg = Target.Value Else deg = 0
End Sub

 

[kerimssv]

Merhaba,
Öncelikle foruma hoş geldiniz.
Aşağıdaki şekilde deneyiniz...

Public deg As Double
Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [B2:B17]) Is Nothing Then Exit Sub
  
    Application.EnableEvents = False
    With Target
        If IsNumeric(.Value) = False Then
            MsgBox "Sadece Sayı Girebilirsiniz", vbCritical
            .Value = deg
            Application.EnableEvents = True
            Exit Sub
        End If
        .Value = .Value + deg
    End With
    Application.EnableEvents = True
  
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, [B2:B17]) Is Nothing Then Exit Sub
    If Target.Cells.Count = 1 Then deg = Target.Value Else deg = 0
End Sub

İşe yaradı çok teşekkür ederim.