Etopla İşlemleri - m_demir - 31/05/2021
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
RE: Etopla İşlemleri - feraz - 01/06/2021
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
RE: Etopla İşlemleri - m_demir - 01/06/2021
Ç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.
RE: Etopla İşlemleri - feraz - 01/06/2021
Rica ederim abey.Öğleden sonra kodları ayarlarım.
Re: Etopla İşlemleri - feraz - 01/06/2021
Alttaki kod A3Son 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("A3" & Rows.Count), Range("F3:i" & Rows.Count)) kısmı.
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" & 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" & 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.
RE: Etopla İşlemleri - m_demir - 01/06/2021
Çok, çok teşekkürler Hocam ellerinize sağlık.
Hocam konuyu taşıyabilirsiniz. Saygılar.
|