AccessTr.neT
Etopla İşlemleri - Baskı Önizleme

+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Etopla İşlemleri (/konu-etopla-islemleri.html)

Sayfalar: 1 2 3 4 5


RE: Etopla İşlemleri - feraz - 02/06/2021

(01/06/2021, 18:31)feraz yazdı: With Range("L3:L1" & satr + 2)

Bordaki 1 silinmesi gerek abey..Alttaki gibi olacak dikkatten kaçmış.
Kod:
With Range("L3:L" & satr + 2)



RE: Etopla İşlemleri - m_demir - 03/06/2021

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


RE: Etopla İşlemleri - feraz - 03/06/2021

Rica ederim abey.
Dahada hızlı çalışsın isterseniz alttaki kodu kullanabilirsiniz.

    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
Yukaraki kodları sevmediğim için başta kullanmamıştım yinede yazayım dedim.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long
    Const satr As Byte = 16 'K sütunundaki verilerin son satir numarasi arananinkilerin
    Const SatirBaslangic As Byte = 2 '3.cü sütundan baslandigi icin 2 yazildi
    Dim sonDoluSatrEtopla As Long
   
    sonDoluSatrEtopla = Cells.Find("*", , , , , xlPrevious).Row + 1

    If Intersect(Target, Union(Range("A3Lol" & Rows.Count), Range("F3:i" & Rows.Count))) Is Nothing Then Exit Sub
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ActiveSheet.Unprotect "123321"
    Range("L3:N" & Rows.Count).ClearContents
    On Error GoTo son
    With Range("L3:L" & satr + SatirBaslangic)
        .Formula = "=SUMIF($A$3:$A$" & sonDoluSatrEtopla & ",K3,$D$3:$D$" & sonDoluSatrEtopla & ")"
        .Value = .Value
    End With

    With Range("M3:M" & satr + SatirBaslangic)
        .Formula = "=SUMIF($F$3:$F$" & sonDoluSatrEtopla & ",K3,$I$3:$I$" & sonDoluSatrEtopla & ")"
        .Value = .Value
    End With 'Etopla sonu

    ReDim arr(1 To satr, 1 To 1)
    For i = 1 To satr
        arr(i, 1) = Cells(i + SatirBaslangic, "L").Value - Cells(i + SatirBaslangic, "M").Value
    Next
    Range("N3:N" & satr + SatirBaslangic).Value = arr
   
    Range("L20").Value = WorksheetFunction.Sum(Range("D3Lol" & sonDoluSatrEtopla))
    Range("L21").Value = WorksheetFunction.Sum(Range("I3:I" & sonDoluSatrEtopla))
    Range("L22").Value = Range("L20").Value - Range("L21").Value
   
    Erase arr
    ActiveSheet.Protect "123321"
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Exit Sub
son:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "hata", vbCritical
End Sub



RE: Etopla İşlemleri - feraz - 05/06/2021

Birde Evaluate yötemii kulladım.Bununla formülleri değer yapmaktansa direk değer yapıyor.


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, satirbasveFazlasi As Long
    Const satr As Byte = 16 'K sütunundaki verilerin son satir numarasi arananinkilerin
    Const SatirBaslangic As Byte = 2 '3.cü sütundan baslandigi icin 2 yazildi
    Dim sonDoluSatrEtopla As Long
   
    sonDoluSatrEtopla = Cells.Find("*", , , , , xlPrevious).Row + 1

    If Intersect(Target, Union(Range("A3Lol" & Rows.Count), Range("F3:i" & Rows.Count))) Is Nothing Then Exit Sub
   
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False
   
    ActiveSheet.Unprotect "123321"
    Range("L3:N" & Rows.Count).ClearContents
    On Error GoTo son
   
    satirbasveFazlasi = satr + SatirBaslangic

    Range("L3:L" & satirbasveFazlasi).Value = Evaluate("=SUMIF($A$3:$A$" & sonDoluSatrEtopla & ",K3:K" & satirbasveFazlasi & ",$D$3:$D$" & sonDoluSatrEtopla & ")")
    Range("M3:M" & satirbasveFazlasi).Value = Evaluate("=SUMIF($F$3:$F$" & sonDoluSatrEtopla & ",K3:K" & satirbasveFazlasi & ",$I$3:$I$" & sonDoluSatrEtopla & ")")

    ReDim arr(1 To satr, 1 To 1)
    For i = 1 To satr
        arr(i, 1) = Cells(i + SatirBaslangic, "L").Value - Cells(i + SatirBaslangic, "M").Value
    Next
    Range("N3:N" & satirbasveFazlasi).Value = arr
   
    Range("L20").Value = WorksheetFunction.Sum(Range("D3Lol" & sonDoluSatrEtopla))
    Range("L21").Value = WorksheetFunction.Sum(Range("I3:I" & sonDoluSatrEtopla))
    Range("L22").Value = Range("L20").Value - Range("L21").Value
   
    Erase arr
    ActiveSheet.Protect "123321"
   
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   
    Exit Sub
son:

    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   
    MsgBox "hata", vbCritical
End Sub



Re: Etopla İşlemleri - m_demir - 06/06/2021

Çok teşekkürler Hocam ellerine sağlık. Eklediğin dosyayı indirdim. inceleyip dönüş yapacam.


Re: Etopla İşlemleri - m_demir - 06/06/2021

Hocam Mesaj 16 daki kodlar daha hızlı çalışıyor. Ancak L ve M hücrelerinde Etoplamları göstermiyor. Mesaj 15 deki kodlar L ve M hücrelerinde Etoplamları gösteriyor. Mesaj 16 daki kodlar daha hızlı çalışıyor. 16 daki kodlar L ve M hücrelerinde Etoplamları göstermediği için mi daha hızlı çalışıyor. Eğer Mesaj 16 daki kotlar Etoplamları gösterdiği zamanda yine öyle hızlı çalışırsa çok iyi.