Seçilen tarih öncesi devreden bakiye yapmak

tgtd · 7 Mart 2020

Merhabalar, ekteki excel dosyamda secili firmanın seçili tarih aralığından önceki bakiyesini devreden bakiye şeklinde, seçilen tarih aralığını da liste şeklinde dökmek istiyorum. yardımlarınız için teşekkürler..

tgtd · 5 Ocak 2021

Yardımcı olabilecek varmı acaba?

veyselemre · 5 Ocak 2021

Kod:

Sub test()
    Set sK = Sheets("kayıt")
    Set sE = Sheets("extre")

    firma = sE.[E16].Value
    basTar = [G17].Value
    sonTar = [I17].Value

    lst = sK.Range("a15:K" & sK.Cells(Rows.Count, 1).End(3).Row).Value
    Dim w(1 To 16, 1 To 6)

    w(1, 4) = "Devreden Bakiye"
    say = 2
    For i = 1 To UBound(lst)
        If lst(i, 3) = firma Then
            If lst(i, 1) < basTar Then
                w(1, 5) = w(1, 5) + lst(i, 7)
                w(1, 6) = w(1, 6) + lst(i, 8)
            ElseIf lst(i, 1) <= sonTar Then
                w(say, 1) = lst(i, 1)
                w(say, 2) = lst(i, 5)
                w(say, 3) = lst(i, 6)
                w(say, 4) = lst(i, 11)
                w(say, 5) = lst(i, 7)
                w(say, 6) = lst(i, 8)
                say = say + 1
            End If
        End If
    Next i
    sE.[A19].Resize(16, 6).Value = w
End Sub

tgtd · 5 Ocak 2021

Üstad Çok Teşekkür ederim,Elinize sağlık, Bakiye Tutarını almıyor üstadım, bir iki denedim ama yapamadım..

veyselemre · 5 Ocak 2021

O kısım örneğinizde formülle çözdüğünüz için eklememiştim.

Kod:

Sub test()
    Set sK = Sheets("kayıt")
    Set sE = Sheets("extre")

    firma = sE.[E16].Value
    basTar = [G17].Value
    sonTar = [I17].Value

    lst = sK.Range("a15:K" & sK.Cells(Rows.Count, 1).End(3).Row).Value
    Dim w(1 To 16, 1 To 8)

    w(1, 4) = "Devreden Bakiye"
    say = 2
    For i = 1 To UBound(lst)
        If lst(i, 3) = firma Then
            If lst(i, 1) < basTar Then
                w(1, 5) = w(1, 5) + lst(i, 7)
                w(1, 6) = w(1, 6) + lst(i, 8)
                w(1, 8) = w(1, 5) - w(1, 6)
            ElseIf lst(i, 1) <= sonTar Then
                w(say, 1) = lst(i, 1)
                w(say, 2) = lst(i, 5)
                w(say, 3) = lst(i, 6)
                w(say, 4) = lst(i, 11)
                w(say, 5) = lst(i, 7)
                w(say, 6) = lst(i, 8)
                w(say, 8) = w(say - 1, 8) + w(say, 5) - w(say, 6)
                say = say + 1
            End If
        End If
    Next i
    sE.[A19].Resize(16, 8).Value = w
End Sub

Korhan Ayhan · 5 Ocak 2021

Bu da alternatif olsun;

Ek olarak alt toplamları alıyor ve biraz şekillendirme yapıyor.

C++:

Option Explicit

Sub Ekstre_Raporu()
    Dim Zaman As Double, S1 As Worksheet, S2 As Worksheet
    Dim Son As Long, X As Long, Say As Long, Veri As Variant
    Dim Firma As String, Tarih1 As Date, Tarih2 As Date
    Dim Toplam_Borc As Double, Toplam_Alacak As Double, Toplam_Bakiye As Double
    
    Zaman = Timer
    
    Application.ScreenUpdating = 0
    
    Set S1 = Sheets("kayıt")
    Set S2 = Sheets("extre")

    S2.Range("A19:H" & S2.Rows.Count).Clear
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son <= 15 Then Son = 16
    
    Veri = S1.Range("A15:K" & Son).Value
    
    ReDim Liste(1 To Son, 1 To 8)
    
    Firma = S2.Range("E16").Value
    Tarih1 = S2.Range("G17").Value
    Tarih2 = S2.Range("I17").Value
    
    Say = 1
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 3) = Firma Then
            If Veri(X, 1) >= Tarih1 And Veri(X, 1) <= Tarih2 Then
                Say = Say + 1
                Liste(Say, 1) = Veri(X, 1)
                Liste(Say, 2) = Veri(X, 5)
                Liste(Say, 3) = Veri(X, 6)
                Liste(Say, 4) = Veri(X, 11)
                Liste(Say, 5) = Veri(X, 7)
                Liste(Say, 6) = Veri(X, 8)
                Liste(Say, 8) = Liste(Say - 1, 8) + Liste(Say, 5) - Liste(Say, 6)
                Toplam_Borc = Toplam_Borc + Liste(Say, 5)
                Toplam_Alacak = Toplam_Alacak + Liste(Say, 6)
                Toplam_Bakiye = Toplam_Borc - Toplam_Alacak
            Else
                Liste(1, 5) = Liste(1, 5) + Veri(X, 7)
                Liste(1, 6) = Liste(1, 6) + Veri(X, 8)
                Liste(1, 8) = Liste(1, 5) - Liste(1, 6)
                Toplam_Borc = Liste(1, 5)
                Toplam_Alacak = Liste(1, 6)
                Toplam_Bakiye = Liste(1, 8)
            End If
        End If
    Next
    
    If Say > 1 Then
        S2.Range("A19:H19").Font.Bold = True
        S2.Range("A19:H19").Font.ColorIndex = 3
        Liste(1, 4) = "Devreden Bakiye"
        Liste(Say + 1, 4) = "Genel Toplam"
        Liste(Say + 1, 5) = Toplam_Borc
        Liste(Say + 1, 6) = Toplam_Alacak
        Liste(Say + 1, 8) = Toplam_Bakiye
        S2.Range("A19").Resize(Say + 1, 8) = Liste
        S2.Range("A18").Resize(Say + 2, 8).Borders.LineStyle = 1
        S2.Range("E19").Resize(Say + 1, 4).Style = "Currency"
        S2.Cells(S2.Rows.Count, 4).End(3).Offset(, -3).Resize(, 8).Font.Bold = True
        S2.Cells(S2.Rows.Count, 4).End(3).Offset(, -3).Resize(, 8).Interior.ColorIndex = 6
        S2.Columns.AutoFit
        Application.ScreenUpdating = 1
        MsgBox "Ekstre raporu hazırlanmıştır." & vbLf & vbLf & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    Else
        Application.ScreenUpdating = 1
        MsgBox "Uygun veri bulunamadı!", vbExclamation
    End If

    Set S1 = Nothing
    Set S2 = Nothing
End Sub

tgtd · 6 Ocak 2021

Üstadlarım Ellerinize Sağlık, Yardımlarınız için çok teşekkür ederim...

tgtd · 6 Ocak 2021

Korhan Ayhan' Alıntı:

Bu da alternatif olsun;

Ek olarak alt toplamları alıyor ve biraz şekillendirme yapıyor.

C++:

Option Explicit

Sub Ekstre_Raporu()
    Dim Zaman As Double, S1 As Worksheet, S2 As Worksheet
    Dim Son As Long, X As Long, Say As Long, Veri As Variant
    Dim Firma As String, Tarih1 As Date, Tarih2 As Date
    Dim Toplam_Borc As Double, Toplam_Alacak As Double, Toplam_Bakiye As Double
   
    Zaman = Timer
   
    Application.ScreenUpdating = 0
   
    Set S1 = Sheets("kayıt")
    Set S2 = Sheets("extre")

    S2.Range("A19:H" & S2.Rows.Count).Clear
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son <= 15 Then Son = 16
   
    Veri = S1.Range("A15:K" & Son).Value
   
    ReDim Liste(1 To Son, 1 To 8)
   
    Firma = S2.Range("E16").Value
    Tarih1 = S2.Range("G17").Value
    Tarih2 = S2.Range("I17").Value
   
    Say = 1
   
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 3) = Firma Then
            If Veri(X, 1) >= Tarih1 And Veri(X, 1) <= Tarih2 Then
                Say = Say + 1
                Liste(Say, 1) = Veri(X, 1)
                Liste(Say, 2) = Veri(X, 5)
                Liste(Say, 3) = Veri(X, 6)
                Liste(Say, 4) = Veri(X, 11)
                Liste(Say, 5) = Veri(X, 7)
                Liste(Say, 6) = Veri(X, 8)
                Liste(Say, 8) = Liste(Say - 1, 8) + Liste(Say, 5) - Liste(Say, 6)
                Toplam_Borc = Toplam_Borc + Liste(Say, 5)
                Toplam_Alacak = Toplam_Alacak + Liste(Say, 6)
                Toplam_Bakiye = Toplam_Borc - Toplam_Alacak
            Else
                Liste(1, 5) = Liste(1, 5) + Veri(X, 7)
                Liste(1, 6) = Liste(1, 6) + Veri(X, 8)
                Liste(1, 8) = Liste(1, 5) - Liste(1, 6)
                Toplam_Borc = Liste(1, 5)
                Toplam_Alacak = Liste(1, 6)
                Toplam_Bakiye = Liste(1, 8)
            End If
        End If
    Next
   
    If Say > 1 Then
        S2.Range("A19:H19").Font.Bold = True
        S2.Range("A19:H19").Font.ColorIndex = 3
        Liste(1, 4) = "Devreden Bakiye"
        Liste(Say + 1, 4) = "Genel Toplam"
        Liste(Say + 1, 5) = Toplam_Borc
        Liste(Say + 1, 6) = Toplam_Alacak
        Liste(Say + 1, 8) = Toplam_Bakiye
        S2.Range("A19").Resize(Say + 1, 8) = Liste
        S2.Range("A18").Resize(Say + 2, 8).Borders.LineStyle = 1
        S2.Range("E19").Resize(Say + 1, 4).Style = "Currency"
        S2.Cells(S2.Rows.Count, 4).End(3).Offset(, -3).Resize(, 8).Font.Bold = True
        S2.Cells(S2.Rows.Count, 4).End(3).Offset(, -3).Resize(, 8).Interior.ColorIndex = 6
        S2.Columns.AutoFit
        Application.ScreenUpdating = 1
        MsgBox "Ekstre raporu hazırlanmıştır." & vbLf & vbLf & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    Else
        Application.ScreenUpdating = 1
        MsgBox "Uygun veri bulunamadı!", vbExclamation
    End If

    Set S1 = Nothing
    Set S2 = Nothing
End Sub

Üstadım Çok oluyorum ama, son bir isteğim olacak.
satırlarda " Tahakkuk İşlemi" yazanlarda o satırı komple farklı renklendirme,
"Tahsilat İşlemi" yazanlarda farklı renklendirme yazıl yapabiliriz

Korhan Ayhan · 6 Ocak 2021

Renklendirme işlemi için koşullu biçimlendirme kullanabilirsiniz.

umit1907 · 18 Haziran 2022

Merhaba Korhan Abi bu senin tabloyu ekteki dosyaya nasıl uyarlayabilirim hangi alanları değiştirmem gerekir.

tgtd · 29 Haziran 2024

Korhan Ayhan' Alıntı:

Bu da alternatif olsun;

Ek olarak alt toplamları alıyor ve biraz şekillendirme yapıyor.

C++:

Option Explicit

Sub Ekstre_Raporu()
    Dim Zaman As Double, S1 As Worksheet, S2 As Worksheet
    Dim Son As Long, X As Long, Say As Long, Veri As Variant
    Dim Firma As String, Tarih1 As Date, Tarih2 As Date
    Dim Toplam_Borc As Double, Toplam_Alacak As Double, Toplam_Bakiye As Double
   
    Zaman = Timer
   
    Application.ScreenUpdating = 0
   
    Set S1 = Sheets("kayıt")
    Set S2 = Sheets("extre")

    S2.Range("A19:H" & S2.Rows.Count).Clear
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son <= 15 Then Son = 16
   
    Veri = S1.Range("A15:K" & Son).Value
   
    ReDim Liste(1 To Son, 1 To 8)
   
    Firma = S2.Range("E16").Value
    Tarih1 = S2.Range("G17").Value
    Tarih2 = S2.Range("I17").Value
   
    Say = 1
   
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 3) = Firma Then
            If Veri(X, 1) >= Tarih1 And Veri(X, 1) <= Tarih2 Then
                Say = Say + 1
                Liste(Say, 1) = Veri(X, 1)
                Liste(Say, 2) = Veri(X, 5)
                Liste(Say, 3) = Veri(X, 6)
                Liste(Say, 4) = Veri(X, 11)
                Liste(Say, 5) = Veri(X, 7)
                Liste(Say, 6) = Veri(X, 8)
                Liste(Say, 8) = Liste(Say - 1, 8) + Liste(Say, 5) - Liste(Say, 6)
                Toplam_Borc = Toplam_Borc + Liste(Say, 5)
                Toplam_Alacak = Toplam_Alacak + Liste(Say, 6)
                Toplam_Bakiye = Toplam_Borc - Toplam_Alacak
            Else
                Liste(1, 5) = Liste(1, 5) + Veri(X, 7)
                Liste(1, 6) = Liste(1, 6) + Veri(X, 8)
                Liste(1, 8) = Liste(1, 5) - Liste(1, 6)
                Toplam_Borc = Liste(1, 5)
                Toplam_Alacak = Liste(1, 6)
                Toplam_Bakiye = Liste(1, 8)
            End If
        End If
    Next
   
    If Say > 1 Then
        S2.Range("A19:H19").Font.Bold = True
        S2.Range("A19:H19").Font.ColorIndex = 3
        Liste(1, 4) = "Devreden Bakiye"
        Liste(Say + 1, 4) = "Genel Toplam"
        Liste(Say + 1, 5) = Toplam_Borc
        Liste(Say + 1, 6) = Toplam_Alacak
        Liste(Say + 1, 8) = Toplam_Bakiye
        S2.Range("A19").Resize(Say + 1, 8) = Liste
        S2.Range("A18").Resize(Say + 2, 8).Borders.LineStyle = 1
        S2.Range("E19").Resize(Say + 1, 4).Style = "Currency"
        S2.Cells(S2.Rows.Count, 4).End(3).Offset(, -3).Resize(, 8).Font.Bold = True
        S2.Cells(S2.Rows.Count, 4).End(3).Offset(, -3).Resize(, 8).Interior.ColorIndex = 6
        S2.Columns.AutoFit
        Application.ScreenUpdating = 1
        MsgBox "Ekstre raporu hazırlanmıştır." & vbLf & vbLf & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    Else
        Application.ScreenUpdating = 1
        MsgBox "Uygun veri bulunamadı!", vbExclamation
    End If

    Set S1 = Nothing
    Set S2 = Nothing
End Sub

Korhan Bey Üstadım Daha önce bana yardımınız olmuştu bu kod ile işlemimi yapıyorum.

Tarih1 = S2.Range("G17").Value buradaki tarihi manuel girerek tarih aralığını listeleyebiliyoruz.
Şöyle bir şey yapmak istiyorum;
çekilen verilerin satır sayısı 20 den fazla ise Tarih1 = S2.Range("G17").Value e çekilen verinin sondan 20.satırın tarihini,
çekilen verilerin satır sayısı 20 den az ise Tarih1 = S2.Range("G17").Value e çekilen verinin ilk satırın tarihini,
yazdırmak istiyorum üstadım

Seçilen tarih öncesi devreden bakiye yapmak

tgtd

Ekli dosyalar

tgtd

veyselemre

Özel Üye

tgtd

veyselemre

Özel Üye

Korhan Ayhan

Administrator

tgtd

tgtd

Korhan Ayhan

Administrator

umit1907

Ekli dosyalar

tgtd