Veri Girişine göre Çarpma

[sirkülasyon]

Es Selamün Aleyküm.
Ekli dosyada aşağıda belirttiğim şekilde makro yazılması için yardımcı olabilir misiniz?
İlgili Dosya Linki

Ancak özür dileyerek ve affınıza sığınarak altın üyeliğimin süresi bittiği için http://www.filebig.net/ sitesine yüklemenizi ya da makroyu paylaşmanızı rica ediyorum.
Saygı ve hürmetlerimle


E6:E40 arasındaki hücrelere veri girişi yapılınca
a) F6:F40 hücrelerine 140 yazılacak
b) G6:G40 hücrelerine de E sütunda ki hücre değeri * F sütununda ki hücre değeri * D1 sütununda ki hücre değeri
c) E6:E40 arasında ki hücrelerde veri silince G ve F sütunları da temizlenecek.

H6:H40 arasındaki hücrelere veri girişi yapılınca
a) I6:I40 hücrelerine 140 yazılacak
b) J6:J40 hücrelerine de H sütunda ki hücre değeri * I sütununda ki hücre değeri * D1 sütununda ki hücre değeri
c) H6:H40 arasında ki hücrelerde veri silince I ve J sütunları da temizlenecek.

K6:K40 arasındaki hücrelere veri girişi yapılınca
a) L6:L40 hücrelerine 150 yazılacak
b) M6:M40 hücrelerine de K sütunda ki hücre değeri * L sütununda ki hücre değeri * D1 sütununda ki hücre değeri
c) K6:K40 arasında ki hücrelerde veri silince L ve M sütunları da temizlenecek.

N6:N40 arasındaki hücrelere veri girişi yapılınca
a) O6:O40 hücrelerine 140 yazılacak
b) P6: P 40 hücrelerine de N sütunda ki hücre değeri * O sütununda ki hücre değeri * D1 sütununda ki hücre değeri
c) N6:N40 arasında ki hücrelerde veri silince O ve P sütunları da temizlenecek.

Q6:Q40 arasındaki hücrelere veri girişi yapılınca
a) R6:R40 hücrelerine 150 yazılacak
b) S6:S40 hücrelerine de Q sütunda ki hücre değeri * R sütununda ki hücre değeri * D1 sütununda ki hücre değeri
c) Q6:Q40 arasında ki hücrelerde veri silince R ve S sütunları da temizlenecek.

T6:T40 arasındaki hücrelere veri girişi yapılınca
a) U6:U40 hücrelerine 140 yazılacak
b) V6:V40 hücrelerine de T sütunda ki hücre değeri * U sütununda ki hücre değeri * D1 sütununda ki hücre değeri
c) T6:T40 arasında ki hücrelerde veri silince U ve V sütunları da temizlenecek.

 

[veyselemre]

Sayfanızın kod kısmına ekleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("6:40"), Range("E:E,H:H,K:K,N:N,Q:Q,T:T")) Is Nothing Then
        If Target.Value = "" Then
            Target.Offset(, 1).Resize(, 2).Value = ""
        ElseIf IsNumeric(Target.Value) Then
            If Not Intersect(Target, Range("K:K,Q:Q")) Is Nothing Then
                Target.Offset(, 1).Value = 150
            Else
                Target.Offset(, 1).Value = 140
            End If
            Target.Offset(, 2).Value = Target.Value * Target.Offset(, 1).Value
        End If
    End If
End Sub

 

[sirkülasyon]

Sayın veyselemre
Makro için teşekkür ederim. Yalnız D1 hücresi ile çarpma yapılmamış. D1 ile çarpım yapılması için nereye ekleme yapabilirim.
Bir de, çarpım sonucu yuvarlansın.

Bu ek taleplerim için yardımcı olursanız memnun olurum. Saygılarımla

 

[veyselemre]

Sayın veyselemre
Makro için teşekkür ederim. Yalnız D1 hücresi ile çarpma yapılmamış. D1 ile çarpım yapılması için nereye ekleme yapabilirim.

            Target.Offset(, 2).Value = Target.Value * Target.Offset(, 1).Value * Range("D1").Value

 

[veyselemre]

Bir de, çarpım sonucu yuvarlansın.

Target.Offset(, 2).Value = Round(Target.Value * Target.Offset(, 1).Value * Range("D1").Value, 2)

 

[sirkülasyon]

Teşekkür ederim.