3 kosula bagli veri tasima

[ozer sinmaz]

Arkadaslar asagidaki linkte yapmis oldugum butce calismasinda yardima ihtiyacim var dosya belirtilen linkteki 2. gondermis oldugum rar dosyasidir.

yardimlariniz icin simdiden tesekkur edederim

Ayriyeten benim de 2 sorum olacak yardimci olabilirseniz sevinirim.

1. Dosyanin son sayfasinda kredi karti ekstresi icin bir sayfa olusturdum ve bu sayfaya girmis oldugum bilgiler gider pusulasinda bulunuyor. ben bu bilgileri harcama tarihine gore gider pusulasindan otomatik olarak ekstreye nasil yazdirabilirim

2. Gider pusulasinda harcama turunu taksitli olarak sectigimde; harcama tutarini taksit sayisina bolerek, taksit sayisi kadar ileri donemki ekstrelere nasil yazdirabilirim

http://www.excel.web.tr/f168/yillik-kisisel-butce-t118012.html

 

[Korhan Ayhan]

Merhaba,

GIDER PUSULASI sayfasının koruması nedir?

 

[ozer sinmaz]

sayfa korumalarinda sifre yok

 

[Korhan Ayhan]

Merhaba,

Örnek dosyayı incelermisiniz.

Aktarım yaparken eski bilgileri silerek aktarmaktadır.

 

[ozer sinmaz]

Korhan Bey

Yardiminiz icin tesekkurler gondermis oldugunuz ornegi inceledim, isime yarayacak kendim de gelistirmeye calisacagim

 

[ozer sinmaz]

Korhan Bey

Yapmis oldugum calismada kredi karti sayfasi 4 adede cikardim ve makroyu buna gore duzenledim sorunsuz calisti.

Fakat soyle bir sikinti olustu, Ekstre donemi olarak gercek hesap kesim tarihleri girerek bu tarihler arasina gore aktarma yapmasi icin dunden beri ugrasiyorum fakat ne yaptiysam beceremedim.

Musait olursaniz son calismami kontrol edip yardimci olabilirmisiniz

 

[ozer sinmaz]

yardim bekliyorum

 

[Korhan Ayhan]

Merhaba,

Bu durumda tarih değişkenini sayfadaki tarihlere göre uyarlamak gerekiyor. Ben ilk sayfanız için örnek kodu veriyorum. Siz diğerleri için çoğaltırsınız.

Tarih = DateSerial(Year(S1.Cells(X, "C")), Month(S1.Cells(X, "C")) + 1, 0)
Tarih = Evaluate("=MAX(IF('" & S2.Name & "'!E5:E1000<="" & Cdate(Tarih) & "",'" & S2.Name & "'!E5:E1000))")
Set Bul_Tarih = S2.Range("E:E").Find(CDate(Tarih))

Kırmızı bölümleri her sayfa için düzenleyip deneyin.

 

[ozer sinmaz]

Korhan Bey

Kusura bakmayin sizi de cok rahatsiz ediyorum, fakat gondermis oldugunuz kodu ekledim. Sorun su ki harcamalarin hepsini sadece tarihi en buyuk olan ekstre donemine atiyor, E ve F sutununda belirtilen ilgili tarih arasina aktarmiyor. Ayrica taksit sayisina gore bolmeyi yapiyor fakat hepsini yine ayni yerde yazdiriyor.

Dosya boyutu kucuk olsun ve acikladigim sorunu daha rahat gorebilmeniz icin gereksiz butun sayfalari cikarttim ve tek kart icin sayfa biraktim.

 

[Korhan Ayhan]

Merhaba,

İftar öncesi tam kontrol etmeden kodu önermişim. Asıl siz kusura bakmayın.

Aşağıdaki kodun sağlıklı çalışması için taksit dönemine ait tarihlerin hepsinin ilgili karta ait sayfada olması gerekiyor. Aksi halde hatalı sonuçlar üretecektir.

Sub EKSTRE()
    Dim S1, S2, X, Y, Taksit, Tarih, Bul_Tarih, Bul_Taksit_Tarihi, Kart_Tipi_1
        
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("GIDER PUSULASI")
    Set S2 = Sheets("GARANTI BONUS K.K.")
    Kart_Tipi_1 = S2.Range("B2")
    
    For X = 6 To S2.Cells(Rows.Count, "B").End(3).Row
        If S2.Cells(X, "B") <> "" And IsNumeric(S2.Cells(X, "B")) Then
            S2.Range("C" & X & ":H" & X).ClearContents
        End If
    Next
    
    For X = 6 To S1.Cells(Rows.Count, "C").End(3).Row
        If S1.Cells(X, "H") = Kart_Tipi_1 Then
            Tarih = DateSerial(Year(S1.Cells(X, "C")), Month(S1.Cells(X, "C")) + 1, 0)
            Tarih = Evaluate("=MAX(IF('" & S2.Name & "'!E5:E1000<=DATE(" & Year(Tarih) & "," & Month(Tarih) & "," & Day(Tarih) & "),'" & S2.Name & "'!E5:E1000))")
            Set Bul_Tarih = S2.Range("E:E").Find(CDate(Tarih))
            If Not Bul_Tarih Is Nothing Then
                If S1.Cells(X, "I") <= 1 Then
                    For Y = Bul_Tarih.Row + 1 To Bul_Tarih.Row + 26
                        If S2.Cells(Y, "C") = "" Then
                            S2.Cells(Y, "C") = S1.Cells(X, "C")
                            S2.Cells(Y, "D") = S1.Cells(X, "F")
                            S2.Cells(Y, "E") = S1.Cells(X, "G") / S1.Cells(X, "I")
                            S2.Cells(Y, "F") = S1.Cells(X, "I")
                            S2.Cells(Y, "G") = "/"
                            S2.Cells(Y, "H") = 1
                            Exit For
                        End If
                    Next
                Else
                    For Taksit = 1 To S1.Cells(X, "I")
                        Tarih = DateSerial(Year(S1.Cells(X, "C")), Month(S1.Cells(X, "C")) + Taksit - 1, Day(Tarih))
                        Tarih = Evaluate("=MAX(IF('" & S2.Name & "'!E5:E1000<=DATE(" & Year(Tarih) & "," & Month(Tarih) & "," & Day(Tarih) & "),'" & S2.Name & "'!E5:E1000))")
                        Set Bul_Taksit_Tarihi = S2.Range("E:E").Find(CDate(Tarih))
                        If Not Bul_Taksit_Tarihi Is Nothing Then
                            For Y = Bul_Taksit_Tarihi.Row + 1 To Bul_Taksit_Tarihi.Row + 26
                                If S2.Cells(Y, "C") = "" Then
                                    S2.Cells(Y, "C") = S1.Cells(X, "C")
                                    S2.Cells(Y, "D") = S1.Cells(X, "F")
                                    S2.Cells(Y, "E") = S1.Cells(X, "G") / S1.Cells(X, "I")
                                    S2.Cells(Y, "F") = S1.Cells(X, "I")
                                    S2.Cells(Y, "G") = "/"
                                    S2.Cells(Y, "H") = Taksit
                                    Exit For
                                End If
                            Next
                        End If
                    Next
                End If
            End If
        End If
    Next
    
    Set Bul_Tarih = Nothing
    Set Bul_Taksit_Tarihi = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
         
    Application.ScreenUpdating = True
 
    MsgBox "Ekstreler" & Chr(10) & Chr(10) & "Harcama bilgileri aktarılmıştır.", vbInformation
End Sub

 

[ozer sinmaz]

Korhan Bey

Maalesef yine olmadi. Degerlendirmeyi yaparken yine ilgili kart sayfasindaki tarihin Ay degerine gore aktarma yapiyor gun kismini dikkate almiyor

 

[ozer sinmaz]

konu guncel

 

[ozer sinmaz]

Korhan Bey

Kusura bakmayin bu konu icin sizi baya mesgul ettim ama henuz cozum bulamadim

 

[Korhan Ayhan]

Merhaba,

Siz örnek dosyanız üzerinde elle bir kart için olması gereken ekstre dağılımını hazırlayıp foruma eklermisiniz. En azından onun üzerinden gideriz. Boşa kürek çekmeyelim.

 

[ozer sinmaz]

Korhan Hocam

Dosya ektedir

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu deneyiniz.

Sub EKSTRE()
    Dim S1, S2, X1, X2, X3, X4, X5, X6
    Dim Taksit, Satir, Kart_Tipi_1, Tarih
 
    Application.ScreenUpdating = False
 
    Set S1 = Sheets("GIDER PUSULASI")
    Set S2 = Sheets("GARANTI BONUS K.K.")
    Kart_Tipi_1 = S2.Range("B2")
 
    For X1 = 6 To S2.Cells(Rows.Count, "B").End(3).Row
        If S2.Cells(X1, "B") <> "" And IsNumeric(S2.Cells(X1, "B")) Then
            S2.Range("C" & X1 & ":H" & X1).ClearContents
        End If
    Next
 
    For X2 = 6 To S1.Cells(Rows.Count, "C").End(3).Row
        If S1.Cells(X2, "H") = Kart_Tipi_1 Then
            For X3 = 5 To S2.Cells(Rows.Count, "B").End(3).Row Step 28
                If S1.Cells(X2, "C") >= S2.Cells(X3, "E") And S1.Cells(X2, "C") <= S2.Cells(X3, "F") Then
                    Satir = X3
                    Exit For
                End If
            Next
 
            If S1.Cells(X2, "I") <= 1 Then
                For X4 = Satir + 1 To Satir + 26
                    If S2.Cells(X4, "C") = "" Then
                        S2.Cells(X4, "C") = S1.Cells(X2, "C")
                        S2.Cells(X4, "D") = S1.Cells(X2, "F")
                        S2.Cells(X4, "E") = S1.Cells(X2, "G") / S1.Cells(X2, "I")
                        S2.Cells(X4, "F") = S1.Cells(X2, "I")
                        S2.Cells(X4, "G") = "/"
                        S2.Cells(X4, "H") = 1
                        Exit For
                    End If
                Next
 
            Else
 
                For Taksit = 1 To S1.Cells(X2, "I")
                    Tarih = DateSerial(Year(S1.Cells(X2, "C")), Month(S1.Cells(X2, "C")) + Taksit - 1, Day(S1.Cells(X2, "C")))
 
                    For X5 = 5 To S2.Cells(Rows.Count, "B").End(3).Row Step 28
                        If Tarih >= S2.Cells(X5, "E") And Tarih <= S2.Cells(X5, "F") Then
                            Satir = X5
                            Exit For
                        End If
                    Next
 
                    For X6 = Satir + 1 To Satir + 26
                        If S2.Cells(X6, "C") = "" Then
                            S2.Cells(X6, "C") = S1.Cells(X2, "C")
                            S2.Cells(X6, "D") = S1.Cells(X2, "F")
                            S2.Cells(X6, "E") = S1.Cells(X2, "G") / S1.Cells(X2, "I")
                            S2.Cells(X6, "F") = Taksit
                            S2.Cells(X6, "G") = "/"
                            S2.Cells(X6, "H") = S1.Cells(X2, "I")
                            Exit For
                        End If
                    Next
                Next
            End If
        End If
    Next
 
    Set S1 = Nothing
    Set S2 = Nothing
 
    Application.ScreenUpdating = True
 
    MsgBox "Ekstreler" & Chr(10) & Chr(10) & "Harcama bilgileri aktarılmıştır.", vbInformation
End Sub

 

[ozer sinmaz]

Korhan Bey merhaba

Son gonderdiginiz kodu denedim sorunsuz olarak calisiyor.

Yardimlariniz icin cok tesekkur ederim.