Makroda otomatik mod hesaplama

[OZCANLOK]

Formda aradım fakat buna benzer bir örnek bulamadım

ekte göndermiş olduğum tabloda açıklamaya çalıştım

yardımcı olacak arkadaşlara şimdiden çok teşekkürler

 

[veyselemre]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect([G2:G9,I2:I9,K2:K9,G12:G19,I12:I19,K12:K19], Target) Is Nothing Then
        If Not Application.Intersect([G2:G9,I2:I9,K2:K9], Target) Is Nothing Then
            md = [C2]
        Else
            md = [C12]
        End If
        If md = 0 Then md = 1
        Target = Round(Target / md, 0) * md
    End If
End Sub

 

[OZCANLOK]

Veysel bey ilginiz çok teşekkürler

 

[OZCANLOK]

Sn Veysel beyin verdiği kodu aşağıdaki gibi düzenledim
Fakat şöyle bir problem oluştu

Hücerleri seçip sildiğim zaman makro hesaplamayı çok uzun sürede yapıyor
birde kırmızı ile belirttiğim Target hücreleri nasıl kısaltabiliriz.
Teşkürler

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Not Application.Intersect(Target, [k17:k23,o1723,s17:s23,w17:w23,aa17:aa23,ae17:ae23,aı17:aı23,am17:am23,aq17:aq23,au17:au23,ay17:ay23,bc17:bc23,bg17:bg23,bk17:bk23,bo17:bo23,bs17:bs23,bw17:bw23,ca17:ca23,ce17:ce23,cı17:cı23,cm17:cm23,cq17:cq23,cu17:cu23,cy17:cy23,dc17:dc23]) Is Nothing Then If Not IsNumeric(Target.Value) Then: Target = "": Exit Sub
md = [ı2]
If md = 0 Then md = 1
Target = Round(Target / md, 0) * md
Exit Sub
ElseIf Not Application.Intersect(Target, [k63:k66,o6366,s63:s66,w63:w66,aa63:aa66,ae63:ae66,aı63:aı66,am63:am66,aq63:aq66,au63:au66,ay63:ay66,bc63:bc66,bg63:bg66,bk63:bk66,bo63:bo66,bs63:bs66,bw63:bw66,ca63:ca66,ce63:ce66,cı63:cı66,cm63:cm66,cq63:cq66,cu63:cu66,cy63:cy66,dc63:dc66]) Is Nothing Then If Not IsNumeric(Target.Value) Then: Target = "": Exit Sub
md1 = [ı3]
If md1 = 0 Then md1 = 1
Target = Round(Target / md1, 0) * md1
Exit Sub
ElseIf Not Application.Intersect(Target, [k38:k46,o3846,s38:s46,w38:w46,aa38:aa46,ae38:ae46,aı38:aı46,am38:am46,aq38:aq46,au38:au46,ay38:ay46,bc38:bc46,bg38:bg46,bk38:bk46,bo38:bo46,bs38:bs46,bw38:bw46,ca38:ca46,ce38:ce46,cı38:cı46,cm38:cm46,cq38:cq46,cu38:cu46,cy38:cy46,dc38:dc46]) Is Nothing Then If Not IsNumeric(Target.Value) Then: Target = "": Exit Sub
md2 = [ı3]
If md2 = 0 Then md2 = 1
Target = Round(Target / md2, 0) * md2
Exit Sub
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
End If
End Sub

 

[OZCANLOK]

BU koduda yardımcı olabilecek arkadaş yok mu

teşekkür ederim

 

[OZCANLOK]

Yardımlarınızı bekliyorum arkadaşlar

teşekkürler