Skip to main content

AccessTr.neT


Etopla İşlemleri

Etopla İşlemleri

Çözüldü #1
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
.rar Gel-Gid.rar (Dosya Boyutu: 52,38 KB | İndirme Sayısı: 5)
Son Düzenleme: 31/05/2021, 23:44, Düzenleyen: m_demir.
Cevapla
#2
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.

Visual Basic Code
Application.EnableEvents = False
Application.EnableEvents = True
Cevapla
#3
Ç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.
Cevapla
#4
Rica ederim abey.Öğleden sonra kodları ayarlarım.
Cevapla
#5
Alttaki kod A3LolSon yada F3:Ison sütunlarda değişklik olunca çalışır.
Dahada hızlansın derseniz mesela D ve I sütunlarda değişiklik olarak ayarlayabilirsiniz koddaki Union(Range("A3Lol" & Rows.Count), Range("F3:i" & Rows.Count)) kısmı.


Visual Basic Code
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:D" & Rows.Count), Range("F3:i" & Rows.Count))) Is Nothing Then Exit Sub
    
    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:D" & sonDoluSatrEtopla))
    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.
Son Düzenleme: 01/06/2021, 17:22, Düzenleyen: feraz.
Cevapla
#6
Çok, çok teşekkürler Hocam ellerinize sağlık.

Hocam konuyu taşıyabilirsiniz. Saygılar.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task