Soru VBA Toplama Sorunu Hakkında

[stirra_ej]

M12 ve q12 sütünları arasında rakamların R12 sütününda toplamı almak istiyorum.
Her veri girişimde işlemler alt alta devam edecek . Anlayan biri Lütfen yardımcı olabilir mi. Çok rica ediyorum..

 

[Orion1]

Buyurun.

Range("R12").Value = WorksheetFunction.Sum(Range("N12:Q12"))

 

[stirra_ej]

Buyurun.

Range("R12").Value = WorksheetFunction.Sum(Range("N12:Q12"))

Hocam istediğim alt alta tüm satırlar toplama yapabilsin yani
n13 q13 aralığına veri girildiğinde r13 e yazsın
n14 q 14 diye r14 diye devam etsin
satır aralığı boş ise boş gözüksün
veri varsa toplama yapsın
yani N2000: q2000 de bile veri olsa r2000 toplamn versin

 

[Orion1]

Dosyayı görmediğim için,sizin anlattıklarınıza bakarak bunu yapabildim:
Buyurun.

Sub dongu_59()
Dim sonsat As Long, i As Long
Range("R:R").ClearContents
sonsat = Cells(Rows.Count, "N").End(xlUp).Row
For i = 1 To sonsat
    If Cells(i, "N").Value <> "" Then
        Range("R" & i).Value = WorksheetFunction.Sum(Range("N" & i & ":Q" & i))
    End If
Next i
MsgBox "Bitti"
End Sub

 

[stirra_ej]

Sayın hocam çok özür diliyorum ama sana exel dosyasını göndermem lazım. Ne yapmaya çalıştığımı anlatamadığımdan dolayı seninde değerli vaktini işgal ediyorum. https://www.dosyayukle.biz/2Tg

 

[stirra_ej]

m + n+ o+p +q = r
burda formül yazarken m stünü dolu ise demememiz lazım
bu sütünlardan hernagi biri de dolu olabilir
her sütünda farklı şeylerin sayıları var ve toplamlarını alacağız
m12 + n12 +o12+ p12+q12 = r12
burda boş hücrede olabilir
örneğin
sadece

m13 + q13 doludur r12 verebilir.

förmülde dememiz gereken şu 5 hücrenin herhangi birinde bir sayı değeri varsa r12 de topla
ama bunu r12 den sonra gelecek alt sütünların hepsinde yap.

 

[stirra_ej]

Lütfen son kez yardımcı olmaya çalışırmısın. benim için çok öenmli. tüm günüm bununla geçti.
Ayrıca söylemeyi unutuyorum kodu Private Sub Worksheet_Change(ByVal Target As Range) arasına yapıştıracağım
butona bağlamayacağım.

 

[Orion1]

Bu linkten indiremedim.
Başka bir linke yüklermisiniz?

 

[stirra_ej]

https://dosya.co/xw4zmqr6yxgi/Tablo_-_Kopya.xlsm.html

 

[Orion1]

Buyurun.
Dosyanız liktedir.

DOSYAYI INDIR

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("M11:Q" & Rows.Count)) Is Nothing Then Exit Sub
Range("R" & Target.Row).Value = WorksheetFunction.Sum(Range("M" & Target.Row & ":Q" & Target.Row))
End Sub

 

[stirra_ej]

Teşekkür ederim hocam, ellerine sağlık. Mükemmel şekilde çalışıyor....

 

[Orion1]

Teşekkür ederim hocam, ellerine sağlık

Rica ederim.
İyi çalışmalar.

 

[stirra_ej]

Hocam ,
Private Sub Worksheet_Change(ByVal Target As Range)
bu kodun içine 2 tane ayrı görev yapması gereken bir makro yerleştirirsem nasıl ayırmam gerekiyor.. İlk sıraya gelen makro çalışıyor ikinci sıradaki çalışmıyor, ne yapmalıyım..

Bu toplama makrosu


Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("M12:Q" & Rows.Count)) Is Nothing Then Exit Sub
Range("R" & Target.Row).Value = WorksheetFunction.Sum(Range("M" & Target.Row & ":Q" & Target.Row))




Bu da başta sıra no verme makrosu

If Intersect(Target, Range("H12:H" & Rows.Count)) Is Nothing Then Exit Sub
Range("A12:A" & Rows.Count).ClearContents
With Range("A12:A" & Cells(Rows.Count, "H").End(3).Row + 0)
.Formula = "=IF(H12="""",COUNTA(H$12:H2)+1,COUNTA(H$12:H12))"
.Value = .Value
End With

alt alta yazınca ilk baştaki çalışıyor diğeri çalışmıyor.. hangisi üste alırsam o çalışıyor...

 

[stirra_ej]

Hocam ya h sutununda adı soyadı var h14 dolu ise a 14 sıra numarası 1 aldırıyordum, şimdi bu toplama formülünü başa yazarsam sıra numarası çalışmıyor sıra no formülünü başa yazarsam toplama çalışmıyor.. Ne yapayım....

 

[Orion1]

Buyurun.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sonsat As Long
On Error Resume Next
If Intersect(Target, Range("M12:Q" & Rows.Count & ",H12:H" & Rows.Count)) Is Nothing Then Exit Sub
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
Cells(Target.Row, "A").Value = sonsat + 1 - 11
Range("R" & Target.Row).Value = WorksheetFunction.Sum(Range("M" & Target.Row & ":Q" & Target.Row))

End Sub

 

[stirra_ej]

Hocam iki formülde çalıştı ama sıra numarası ile ilgili bir sorun var 4 ten başlıyor ve hiç değişmiyor alt alta 4- - 4 --- 4- --4 olarak ilerliyor..

 

[stirra_ej]

Hocam Küçük bir değişikle çözülmüştür,, Emeklerinden dolayı çok çok teşekkür ederim.


Dim sonsat As Long
On Error Resume Next
If Intersect(Target, Range("M12:Q" & Rows.Count & ",H12:H" & Rows.Count)) Is Nothing Then Exit Sub
With Range("A12:A" & Cells(Rows.Count, "H").End(3).Row + 0)
.Formula = "=IF(H12="""",COUNTA(H$12:H2)+1,COUNTA(H$12:H12))"
End With
Range("R" & Target.Row).Value = WorksheetFunction.Sum(Range("M" & Target.Row & ":Q" & Target.Row))

End Sub

 

[Orion1]

Hocam Küçük bir değişikle çözülmüştür,, Emeklerinden dolayı çok çok teşekkür ederim.

Rica ederim.
İyi çalışmalar.