Etopla İşlemleri

1 2 3 4 5

Merhaba Arkadaşlar

Aşağıdaki kodlar ile ETOPLAMA, Toplama ve çıkarma işlemlerini yapıyorum. Kodları eklemeden dosya normal çalışıyordu. Bu kodları ekledikten sonra Gelir ve Gider satırlarına veri girmek için tıkladığım her hücrede meşgule duruma geçiyor. Beli bir süre sonra işlem yapıyor. Yani Excel sayfası ağırlaştı.

Bunun için yardımlarınıza ihtiyacım var.

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Etopla başı

Range("L3:L" & Rows.Count).ClearContents

    With Range("L3:L18")

        .Formula = "=SUMIF($A$3:$A$150,K3,$D$3:$D$150)"

        .Value = .Value

    End With

Range("M3:M" & Rows.Count).ClearContents

    With Range("M3:M18")

        .Formula = "=SUMIF($F$3:$F$150,K3,$I$3:$I$150)"

        .Value = .Value

    End With 'Etopla sonu

Range("L20").Formula = "=Sum(D3:D150)"

Range("L21").Formula = "=Sum(I3:I150)"

Range("L22") = (Range("L20") - Range("L21"))

Range("N3") = (Range("L3") - Range("M3"))

Range("N4") = (Range("L4") - Range("M4"))

Range("N5") = (Range("L5") - Range("M5"))

Range("N6") = (Range("L6") - Range("M6"))

Range("N7") = (Range("L7") - Range("M7"))

Range("N8") = (Range("L8") - Range("M8"))

Range("N9") = (Range("L9") - Range("M9"))

Range("N10") = (Range("L10") - Range("M10"))

Range("N11") = (Range("L11") - Range("M11"))

Range("N12") = (Range("L12") - Range("M12"))

Range("N13") = (Range("L13") - Range("M13"))

Range("N14") = (Range("L14") - Range("M14"))

Range("N15") = (Range("L15") - Range("M15"))

Range("N16") = (Range("L16") - Range("M16"))

Range("N17") = (Range("L17") - Range("M17"))

Range("N18") = (Range("L18") - Range("M18"))

End Sub

Merhaba.
SelectionChange kullanılması zaten baştan yanlış.Worksheet_Change kullanılabilir.
Normalde alttaki kodlar sayfa için kullanılır bu durumlarda.

Sizin kod sayfaya her bişey eklemede tekrar tekrar çalıştığı için böyle kilitlenir.
Onunyerine belirli sütundaki veri değişince çalışsın kodu eklenebilir.
Ve dizi içine alınırsa daha hızlı olur.

Application.EnableEvents = False

Application.EnableEvents = True

Çok teşekkürler Hocam.

Eklediğim kodu incelermisiniz hata veriyor. Bir de N3 den N18 kadar her bir çıkarma için bir satır kod ekledim. bu Kod kısaltılabilir mi.

Rica ederim abey.Öğleden sonra kodları ayarlarım.

Alttaki kod A3 Dahada hızlansın derseniz mesela D ve I sütunlarda değişiklik olarak ayarlayabilirsiniz koddaki Union(Range("A3

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim i As Long

    Const satr As Byte = 16

    Dim sonDoluSatrEtopla As Long

    

    sonDoluSatrEtopla = Cells.Find("*", , , , , xlPrevious).Row + 1

    

    'Application.EnableEvents = False

  

    If Intersect(Target, Union(Range("A3
    

    Range("L3:N" & Rows.Count).ClearContents



On Error GoTo son



    With Range("L3:L1" & satr + 2)

        .Formula = "=SUMIF($A$3:$A$" & sonDoluSatrEtopla & ",K3,$D$3:$D$" & sonDoluSatrEtopla & ")"

        ' .Formula = "=SUMIF($A$3:$A$150,K3,$D$3:$D$150)"

        .Value = .Value

    End With



    With Range("M3:M" & satr + 2)

        .Formula = "=SUMIF($F$3:$F$" & sonDoluSatrEtopla & ",K3,$I$3:$I$" & sonDoluSatrEtopla & ")"

'        .Formula = "=SUMIF($F$3:$F$150,K3,$I$3:$I$150)"

        .Value = .Value

    End With 'Etopla sonu



    ReDim arr(1 To satr, 1 To 1)

    For i = 1 To satr

        arr(i, 1) = Cells(i + 2, "L").Value - Cells(i + 2, "M").Value

    Next

    Range("N3:N" & satr + 2).Value = arr

    

    Range("L20").Value = WorksheetFunction.Sum(Range("D3
    Range("L21").Value = WorksheetFunction.Sum(Range("I3:I" & sonDoluSatrEtopla))

    Range("L22").Value = Range("L20").Value - Range("L21").Value

    

    Erase arr

'Application.EnableEvents = True

Exit sub

son:

    'Application.EnableEvents = True

Msgbox "hata"



End Sub

Sayfa korumalı olduğu içinde başa unprotect li kodu sonada protect li kodu ekleyin unutmuşum eklemeyi.

Çok, çok teşekkürler Hocam ellerinize sağlık.

Hocam konuyu taşıyabilirsiniz. Saygılar.

1 2 3 4 5

Etopla İşlemleri

m_demir

feraz

m_demir

feraz

feraz

m_demir