Soru Makro ile Çarpma ile Toplama İşlemi Yaptırma

[RBozkurt]

Merhaba
Alttaki tabloda1. satırda belirtmiş olduğum formülü artan satırlar şeklinde makroya nasıl çevirebiliriz? Teşekkür ederim.

DN (A1 HÜCRESİDİR)	K M²	İ M²	BİRİM_BEDEL	K_BEDEL	İ_BEDEL	TOPLAM_BEDEL
1​	3.44​	1.33​	14.49​	=B2*D2	=(D2*0.35)*C2	=E2+F2
2​	20.77​	1358.62​	14.49​	300.96​	6890.24​	7191.20​
3​	0.00​	1039.96​	14.49​	0.00​	5274.16​	5274.16​
4​	0.00​	15.65​	5.59​	0.00​	30.62​	30.62​
5​	9.52​	1433.49​	14.49​	137.94​	7269.94​	7407.89​

 

[AdemCan]

Merhaba, örnek olarak döngü ile yapılabilir.

Sub hesapla()
Application.ScreenUpdating = False
Dim s1 As Worksheet, son As Long, i As Long
Set s1 = Sheets("HESAP")
son = s1.Cells(Rows.Count, 1).End(3).Row

For i = 2 To son
    s1.Cells(i, "E") = s1.Cells(i, "B") * s1.Cells(i, "D") 'B2*D2
    s1.Cells(i, "F") = (s1.Cells(i, "D") * 0.35) * s1.Cells(i, "C") '(D2*0,35)*C2
    s1.Cells(i, "G") = s1.Cells(i, "E") + s1.Cells(i, "F") 'E2+F2
Next i

Set s1 = Nothing: son = 0: i = 0
Application.ScreenUpdating = True
End Sub

 

[Ziynettin]

Alternatif,

B, C, D sütununa değer girildiğinde yapılan çalışma.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column > 1 And Target.Column < 5 And Target.Row > 1 Then
        sat = Target.Row
        b = Cells(sat, 2): c = Cells(sat, 3): d = Cells(sat, 4)
        Cells(sat, 5) = b * d
        Cells(sat, 6) = (d * 0.35) * c
        Cells(sat, 7) = (b * d) + ((d * 0.35) * c)
    End If
End Sub

 

[RBozkurt]

2 numaralı mesajdakini kullandım. Diğerini nasıl çalıştıracağım bulamadım
Elinize sağlık çok teşekkür ederim.

 

[AdemCan]

Sn @Ziynettin 'in paylaşmış olduğu kod İlgili Sayfada belirtilen sütunlara veri girdikçe çalışır. Yani herhangi bir nesneye makro ataması olmaz.

İlgili sayfa üzerinde Sağ Tuş Kod Görüntüleyi tıklayıp açılan sayfaya kodları yapıştırınız ve belirtilen sütunlara değer giriniz, hesaplama işlemi E - F - G sütunlarına yazılır.

 

[RBozkurt]

Sn @Ziynettin 'in paylaşmış olduğu kod İlgili Sayfada belirtilen sütunlara veri girdikçe çalışır. Yani herhangi bir nesneye makro ataması olmaz.

İlgili sayfa üzerinde Sağ Tuş Kod Görüntüleyi tıklayıp açılan sayfaya kodları yapıştırınız ve belirtilen sütunlara değer giriniz, hesaplama işlemi E - F - G sütunlarına yazılır.
Ekli dosyayı görüntüle 233464

Çok teşekkür ederim bunu da öğrenmiş oldum

 

[AdemCan]

Rica ederim.

 

[RBozkurt]

Merhaba, örnek olarak döngü ile yapılabilir.

Sub hesapla()
Application.ScreenUpdating = False
Dim s1 As Worksheet, son As Long, i As Long
Set s1 = Sheets("HESAP")
son = s1.Cells(Rows.Count, 1).End(3).Row

For i = 2 To son
    s1.Cells(i, "E") = s1.Cells(i, "B") * s1.Cells(i, "D") 'B2*D2
    s1.Cells(i, "F") = (s1.Cells(i, "D") * 0.35) * s1.Cells(i, "C") '(D2*0,35)*C2
    s1.Cells(i, "G") = s1.Cells(i, "E") + s1.Cells(i, "F") 'E2+F2
Next i

Set s1 = Nothing: son = 0: i = 0
Application.ScreenUpdating = True
End Sub

@faye_efsane merhaba
Paylaşmış olduğunuz kodda işlem sonucu küsüratlı bir işlem olunca örnek 33.3244692018083 gibi çıkıyor.
Hücreye doğrudan yuvarlanmış değeri yazdırabilirmiyiz? 33.32 gibi, virgülden sonra 2 hane olacak şekilde. Teşekkürler.

 

[AdemCan]

Merhaba,
Döngüyü güncelleyiniz.

For i = 2 To son
    s1.Cells(i, "E") = Format((s1.Cells(i, "B") * s1.Cells(i, "D")), "#,##0.00") * 1 'B2*D2
    s1.Cells(i, "F") = Format(((s1.Cells(i, "D") * 0.35) * s1.Cells(i, "C")), "#,##0.00") * 1 '(D2*0,35)*C2
    s1.Cells(i, "G") = Format((s1.Cells(i, "E") + s1.Cells(i, "F")), "#,##0.00") * 1 'E2+F2
Next i

 

[RBozkurt]

Merhaba,
Döngüyü güncelleyiniz.

For i = 2 To son
    s1.Cells(i, "E") = Format((s1.Cells(i, "B") * s1.Cells(i, "D")), "#,##0.00") * 1 'B2*D2
    s1.Cells(i, "F") = Format(((s1.Cells(i, "D") * 0.35) * s1.Cells(i, "C")), "#,##0.00") * 1 '(D2*0,35)*C2
    s1.Cells(i, "G") = Format((s1.Cells(i, "E") + s1.Cells(i, "F")), "#,##0.00") * 1 'E2+F2
Next i

Teşekkür ederim problemim düzeldi.

 

[AdemCan]

Rica ederim.