otomatik aktarım

[Barons]

merhaba

R sütunundaki tarih bugünün tarihi ile eşitlendiğinde otomatik olarak o satırdaki verinin giriş ve çıkış olarak 2 ayrı satır olarak makro ile kaydedilmesi mümkünmüdür?

tabi sayfada R sütununda birden fazla bugüne eşit değerlerde olabilir.

Çok teşekkürler

 

[Barons]

Üstadlar yardım pls.

 

[Orion1]

Kırmızı satırlar nereye kaydedilecek?

 

[Barons]

yine aynı sayfaya hocam...tabi aralara 1 ay içinde başka veriler girmiş olacak,dolayısı ile veri tabanı mantığı ile en son satırı bulup ,oraya kaydedilecek.

 

[Barons]

Evren hocam yinemi anlatamadım meramımı acaba ?
kırmızı satırlar aynı sayfaya olacak ama eğer mümkün değilse başka sayfayada olabilir.

 

[usubaykan]

Merhaba,

Anladığım kadarıyla sizin için önemli olan Bugün tarihinin "R" sütunundaki tarihe eşit olması. Eğer "R" sütunundaki tarih eşit ise "B" sütununda son_satır + 1 e "R" sütunundaki bugünun tarihine eşit olan satır aralığı kopyalanmaktadır. Umarım işinizi görür. Aşağıdaki kodu inceler misiniz?

Option Explicit
Sub AKTAR()
    Dim U As Long, SON_SATIR As Long
        For U = 2 To [A65536].End(3).Row
            If Date = Cells(U, "R") Then
                SON_SATIR = [B65536].End(3).Row
                Range("B" & U & ":L" & U).Copy
                Range("B" & SON_SATIR + 1 & ":L" & SON_SATIR + 1).PasteSpecial
            End If
        Next
    Application.CutCopyMode = False
End Sub

 

[Barons]

Hocam katkınız için çok teşekkürler ancak benim istediğim bu değil.
tipik bir POS makinası uygulaması: yani bir pos makinasından para sisteme girdiğinde 30 gün sonra ancak parayı alabilirsiniz.bu uygulama aslında bununla ilgili.
yani 20 martta sisteme 200 TL giriyor ve 30 gün sonra yani çekme tarihide 19 nisan olarak R sütununa giriliyor.
19 nisan günü geldiğinde otomatik olarak bu 200 TL nin 7nci satırdaki pos hesabından çıkış yapması ve 8nci satırda olduğu gibi HSCB bankasına giriş yapmasını kastediyorum.

 

[usubaykan]

Merhaba,

Aşağıdaki kodu dener misiniz?

Option Explicit
Sub Ödemeye_göre_aktar()
Dim u As Long, Son_Satır As Long
    For u = 2 To [A65536].End(3).Row
        Son_Satır = [A65536].End(3).Row
        If Cells(u, "R") - Cells(u, "B") = 30 Then
                Cells(Son_Satır + 1, "A") = Cells(Son_Satır, "A") + 1
                Cells(Son_Satır + 2, "A") = Cells(Son_Satır, "A") + 2
                Cells(Son_Satır + 1, "B") = Format(Cells(u, "R"), "dd.mm.yyyy")
                Cells(Son_Satır + 2, "B") = Format(Cells(u, "R"), "dd.mm.yyyy")
                Cells(Son_Satır + 1, "D") = "Çıkış"
                Cells(Son_Satır + 2, "D") = "Giriş"
                Cells(Son_Satır + 1, "J") = Cells(u, "J")
            If Mid(Cells(u, "J"), 1, 3) = "Pos" Then
            Cells(Son_Satır + 2, "J") = Mid(Cells(u, "J"), 4, 10)
                Cells(Son_Satır + 1, "L") = Cells(u, "K")
                Cells(Son_Satır + 2, "K") = Cells(u, "K")
            Else: Cells(Son_Satır + 2, "J") = Cells(u, "J")
                Cells(Son_Satır + 1, "L") = Cells(u, "K")
                Cells(Son_Satır + 2, "K") = Cells(u, "K")
            End If
        End If
    Next
MsgBox "İşleminiz tamamlanmıştır", vbInformation
End Sub

 

[Barons]

Hocam çok teşekkürler..elinize sağlık

 

[usubaykan]

Hocam çok teşekkürler..elinize sağlık

Rica ederim