AccessTr.neT

Tamam abey sadece aklınızda bulunsun diye tablosuz pivot yaptım dinamik çalışıyor son satır noya göre.

Son defa şunuda ekleyeyim konuyu kapattım abey.
Bu dosya öncekilerden hızlı çalışır gifi izleyebilirsiniz.Sayfa kodlarını sildiğim için kopyalayınca Formül Çalıştır butonuna tıklanması gerekmektedir.
Gerekli font ayarlarıda eklendi.Ayrıca öncekilerde application.enableevents ler vardı yanlışlık olunca kod çalışmayabiliyor gerçi koşullarıda ekledim hata olursa felan diye lakin yinede yazayım istedim.sheetsChange kodu olduğı için bazen mecbur eklenmesi gerekiyor kısır döngüye girmemesi için.Artık hangisi uygunsa onu kullanın.

Kolay gelsin.

Sub KapananHesabySil()

    Dim Syf As Worksheet, sonstr As Long, i As Long

    Set Syf = ThisWorkbook.Worksheets("Vadeli Hesap")

    With Syf

        If .ListObjects("Vadeli_Hesap").AutoFilter.FilterMode = True Then .ShowAllData

        On Error GoTo son

        If WorksheetFunction.CountA(.Range("A2:A" & Rows.Count)) = 0 Then GoTo son

        Application.Calculation = xlCalculationManual

        sonstr = .Cells(.Rows.Count, "A").End(xlUp).Row

        If sonstr < 2 Then GoTo son

        For i = sonstr To 2 Step -1

            If Val(.Cells(i, "g").Value2) <= 0 Then .Range("A" & i).EntireRow.Delete

        Next

        AktarFormul

        

    End With

son:

    Application.Calculation = xlCalculationAutomatic

    Set Syf = Nothing

End Sub

Sub AktarFormul()

    Dim sonstr As Long

    On Error GoTo son

    With ThisWorkbook.Worksheets("Vadeli Hesap")

    If .ListObjects("Vadeli_Hesap").AutoFilter.FilterMode = True Then .ShowAllData

        sonstr = .Cells(Rows.Count, "A").End(xlUp).Row

        If sonstr < 2 Then Exit Sub

        Application.ScreenUpdating = False

        .Range("A2:A" & Rows.Count).ClearContents

        .Range("G2:i" & Rows.Count).ClearContents

        .Range("A2:A" & sonstr).FormulaR1C1 = "=IF([@[HESAP NO]]<>"""",ROW()-1,"""")"

        .Range("H2:H" & sonstr).FormulaR1C1 = "=IF(RC[-5]<>"""",RC[-3]-RC[-2],"""")"

        .Range("i2:i" & sonstr).FormulaR1C1 = "=IF(RC[-6]<>"""",SUM(R2C5:RC[-4])-SUM(R2C6:RC[-3]),"""")"

        .Range("G2:G" & sonstr).FormulaR1C1 = "=IF([@[HESAP NO]]<>"""",ROUND(SUMIFS(C[1],C[-5],[@[DOSYA NO]],C[-4],[@[HESAP NO]]),2),"""")"

'        .Range("G2:i" & sonstr).Value = .Range("G2:i" & sonstr).Value' aktif olursa formüller degere dönüsür

'        .Range("A2:A" & sonstr).Value = .Range("A2:A" & sonstr).Value' aktif olursa formüller degere dönüsür

        With .Range("A2:G" & Rows.Count).Font

            .Name = "Tahoma"

            .Size = 11

        End With

         .Range("G2:G" & sonstr).Font.Bold = True

     End With

son:



    Application.ScreenUpdating = True

    MsgBox "islem tamam"

End Sub