Tıklama ile Toplama

[mavi674]

Merhaba
D8:F15 Hücrelerine formüller vasıtası ile rakamlar var. Bu aralıkta bulunan rakamları toplamak istediklerimize tek tık ile tıklayarak
E5 hücresine toplamları yazsın....
Teşekkürler.

Hata indir

Hata

www.dosyaupload.com

 

[Mdemir63]

Selam

Aşağıdaki kodları Sayfanın kod penceresine yapıştırıp deneyiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      If Not Intersect(Target, Range("D8:F15")) Is Nothing Then
            Range("E5") = Range("E5") + Target.Value
      End If
End Sub

 

[dEdE]

Alternatif
E5 hücresini sıfırlamak için E5 hücresine tıklamak yeterlidir.
Yanlışlıkla birden fazla hücre seçilmesi halinde kodun hata ile sonlanmasını engeller.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("E5")) Is Nothing Then Range("E5") = 0  ' Sıfır yerine "" kullanarak E5 hücresini boşaltabilirsiniz.
If Not Intersect(Target, Range("D8:F15")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    Range("E5") = Range("E5").Value + Target.Value
End If
End Sub

 

[mavi674]

Çok Teşekkürler
Mükemmel kodlar yazıyorsunuz, sizlere minnettarım. İyi ki varsınız...
Kodların her ikisini de kullandım. Süper.. Yalnız ufak bir durum var.
Hani hücrelere rakamlar formülle geliyor demiştim ya Bir hücreye mesela E9 tıklıyorum sonra,
Formülle hücre değeri değiştiği için aynı hücreye (E9) bir daha tıkladığımda toplama yapmıyor.
(Önceden bu hücreyi topladığı için 2 ci toplamayı yapmıyor.
İlgilerinize teşekkürler...

 

[mavi674]

Alternatif
E5 hücresini sıfırlamak için E5 hücresine tıklamak yeterlidir.
Yanlışlıkla birden fazla hücre seçilmesi halinde kodun hata ile sonlanmasını engeller.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("E5")) Is Nothing Then Range("E5") = 0  ' Sıfır yerine "" kullanarak E5 hücresini boşaltabilirsiniz.
If Not Intersect(Target, Range("D8:F15")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    Range("E5") = Range("E5").Value + Target.Value
End If
End Sub

E5=0 yerine
e5="TIKLA-TOPLA" yazınca
e5 rakam olmadığı için hata veriyor, toplamıyor.

 

[mavi674]

Kodu böyle ekleme yaptım
İmleç her tıklamada e4 gidiyor ve aynı hücreyi tıklama şansı oluyor,
ayrıca e5 gücresinde de yazı varsa hata veriyordu ya bende bu hatayı alınca e5 hücresini sıfırlattım ve çalışma devam etti..
Ana kodlarınız içim teşekkürler.
Belki kulağımı uzun yoldan gösteredim ama bu kadar yapabildim.
Teşekkürlerrrrr.....

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo  Nosıfır ' Hata durumunda Nosıfır etiketine git
If Not Intersect(Target, Range("E5")) Is Nothing Then Range("E5") = "TIKLA-TOPLA "
 Not Intersect(Target, Range("D8:F15")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    Range("E5") = Range("E5").Value + Target.Value
    Range("e4").Select
End If
Exit Sub
Nosıfır:
  Range("e5") = 0
 Range("e4").Select
End Sub