Makro ile bir kaç sütuna göre formül hesaplatma.

[uygaroz]

İyi günler.

AMAÇ : Yapmak istediğim 5 sütundan her hangi birinde değer değiştiğinde veya yeni değer girildiğinde sonucun hesaplanması ve ilgili hücreye sadece değerin yazılması.

*** Makro ile ilgili hücreye formülün getirilmesi benim için bir değişiklik yapmayacak. Hücrede yeniden formül olduğundan dosyam yine kabarmaya devam edecek.

Makro bilgimin olmaması nedeniyle başka makrolardan uyarlama yapmaya çalışarak çözmeyi denesem de bir türlü sonuç alamadım...

Yardım edecek arkadaşlara şimdiden teşekkürler.
Uygar

 

[mancubus]

hız sağlar mı bilmiyorum ama sayfadaki formüllerin VBA versiyonu aşağıdaki gibi.

ilgili sayfanın kod modülüne kopyalanacak.

"F:J" aralığındaki sütunlar ile "AB" sütunundaki hücrelere bir veri girişi yapıldığında veya hücrelerde veri değişikliği yapıldığında kendiliğinden devreye girer.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Union(Columns("F:J"), Columns("AB"))) Is Nothing Then Exit Sub
    
    Select Case Cells(Target.Row, "AB").Value
        Case "ç"
            Cells(Target.Row, "L") = Application.RoundUp(((((Cells(Target.Row, "F") + 50) / 2) ^ 2) * 3.14 * 7.8 * (Cells(Target.Row, "G") + 60) + (((Cells(Target.Row, "H") + 40) / 2) ^ 2) * 3.14 * 7.8 * (Cells(Target.Row, "I") + Cells(Target.Row, "J") + 225)) / 1000000, 0)
            Cells(Target.Row, "M") = Application.RoundUp(((((Cells(Target.Row, "F")) / 2) ^ 2) * 3.14 * 7.8 * (Cells(Target.Row, "G")) + (((Cells(Target.Row, "H")) / 2) ^ 2) * 3.14 * 7.8 * (Cells(Target.Row, "I") + Cells(Target.Row, "J"))) / 1000000, 0)
        Case Else
            Cells(Target.Row, "L") = Application.RoundUp(((((Cells(Target.Row, "F") + 20) / 2) ^ 2) * 3.14 * 7.5 * (Cells(Target.Row, "G") + 30) + (((Cells(Target.Row, "H") + 20) / 2) ^ 2) * 3.14 * 7.5 * (Cells(Target.Row, "I") + Cells(Target.Row, "J") + 225)) / 1000000, 0)
            Cells(Target.Row, "M") = Application.RoundUp(((((Cells(Target.Row, "F")) / 2) ^ 2) * 3.14 * 7.5 * (Cells(Target.Row, "G")) + (((Cells(Target.Row, "H")) / 2) ^ 2) * 3.14 * 7.5 * (Cells(Target.Row, "I") + Cells(Target.Row, "J"))) / 1000000, 0)
    End Select

End Sub

 

[uygaroz]

Mancubus
yardımlarınızdan dolayı çok teşekkür ederim.
sizden bir ricam daha olabilir mi, ilk mesajımda atlamışım bunu.

"J" sütununda bir değer olmazsa makronun durmasını gerekli.
"J" sütunu boş oldugunda manuel olarak hesaplama yapıyoruz.
Teşekkürler
Uygar

 

[mancubus]

rica ederim.

aslında siz de kodları inceleyerek gerekli satırı ilave edebilrsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Union(Columns("F:J"), Columns("AB"))) Is Nothing Then Exit Sub
    If Cells(Target.Row, "J") = "" Then Exit Sub    

    Select Case Cells(Target.Row, "AB").Value
        Case "ç"
            Cells(Target.Row, "L") = Application.RoundUp(((((Cells(Target.Row, "F") + 50) / 2) ^ 2) * 3.14 * 7.8 * (Cells(Target.Row, "G") + 60) + (((Cells(Target.Row, "H") + 40) / 2) ^ 2) * 3.14 * 7.8 * (Cells(Target.Row, "I") + Cells(Target.Row, "J") + 225)) / 1000000, 0)
            Cells(Target.Row, "M") = Application.RoundUp(((((Cells(Target.Row, "F")) / 2) ^ 2) * 3.14 * 7.8 * (Cells(Target.Row, "G")) + (((Cells(Target.Row, "H")) / 2) ^ 2) * 3.14 * 7.8 * (Cells(Target.Row, "I") + Cells(Target.Row, "J"))) / 1000000, 0)
        Case Else
            Cells(Target.Row, "L") = Application.RoundUp(((((Cells(Target.Row, "F") + 20) / 2) ^ 2) * 3.14 * 7.5 * (Cells(Target.Row, "G") + 30) + (((Cells(Target.Row, "H") + 20) / 2) ^ 2) * 3.14 * 7.5 * (Cells(Target.Row, "I") + Cells(Target.Row, "J") + 225)) / 1000000, 0)
            Cells(Target.Row, "M") = Application.RoundUp(((((Cells(Target.Row, "F")) / 2) ^ 2) * 3.14 * 7.5 * (Cells(Target.Row, "G")) + (((Cells(Target.Row, "H")) / 2) ^ 2) * 3.14 * 7.5 * (Cells(Target.Row, "I") + Cells(Target.Row, "J"))) / 1000000, 0)
    End Select

End Sub

 

[mancubus]

Eğer J'ye veri girildiğinde, silindiğinde kod çalışmasın isteniliyorsa Columns("F:J") kısmını Columns("F:I") olarak düzeltmek yeterli.

 

[uygaroz]

Eğer J'ye veri girildiğinde, silindiğinde kod çalışmasın isteniliyorsa Columns("F:J") kısmını Columns("F:I") olarak düzeltmek yeterli.

Burnumun dibindekini görememişim.
Çok teşekkür ederim yardımlarınız için
Uygar