Sayıları silinmeden tarihe göre ekleme

[KURVAZE]

Merhaba arkadaşlar.Eteki sayfada fatura tutarının silinmeden önce tarihe göre tutar eklenmesini yapamadım.yardımcı olursanız sevinirim.iyi çalışmalar

 

[1Al2Ver]

Merhaba arkadaşlar.Eteki sayfada fatura tutarının silinmeden önce tarihe göre tutar eklenmesini yapamadım.yardımcı olursanız sevinirim.iyi çalışmalar

Sayın KURVAZE merhaba,

23 Mayıs 2009 da aşağıdaki linkte sizin başlığı farklı ama içeriği aynı olan bir isteğiniz var, farklı katagorilere farklı başlık atmak yerine linkte isteğinizi yenileyebilirdiniz, biraz sabır, mutlaka konusunda uzman bir üyemiz size çözüm sunacaktır, teşekkür ederim.

http://www.excel.web.tr/f14/diger-sayfaya-tarihe-gore-toplama-t69689.html

 

[1Al2Ver]

Merhaba arkadaşlar.Eteki sayfada fatura tutarının silinmeden önce tarihe göre tutar eklenmesini yapamadım.yardımcı olursanız sevinirim.iyi çalışmalar

Merhabalar,

Soruya ben de muhatap oldum, çünkü sayın KURVAZE'ye çözüm olacak dosyanın bir benzeri de bende mevcut , çözümden örnekleme yaparak ben de faydalanmak istiyorum,

Teşekkür ederim.

 

[1Al2Ver]

Merhaba,

Gerekli kodu rica ediyorum,

Teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub silfatura()
    Set s1 = Sheets("fatura")
    Set s2 = Sheets("liste")
    Set s3 = Sheets("2009 CİRO")
    sor = MsgBox("Liste Temizlenecek ! Eminmisiniz?", 52, "Uyarı !")
    If sor = vbNo Then Exit Sub
    
    Ay = Format(s1.Range("f5"), "mmmm")
    Gün = Format(s1.Range("f5"), "d")
    
    Set Bul_Ay = s3.Range("A2:IV2").Find(Ay)
    
    If Not Bul_Ay Is Nothing Then
    Bul_Gün = s3.Range(s3.Cells(2, Bul_Ay.Column), s3.Cells(35, Bul_Ay.Column)).Find(Gün).Row
    s3.Cells(Bul_Gün, Bul_Ay.Column + 2) = s3.Cells(Bul_Gün, Bul_Ay.Column + 2) + s1.Cells(65536, "F").End(3).Value
    Set Bul_Ay = Nothing
    
    Else
    
    MsgBox "2009 CİRO sayfasında " & Ay & " ayına ait bilgi girişi bulunamamıştır." & vbCrLf & _
    "Lütfen ilgili ayı ekledikten sonra tekrar deneyiniz.", vbCritical, "Dikkat !"
    Set Bul_Ay = Nothing
    Exit Sub
    End If
    
    s1.Range("c2:c6").ClearContents
    s1.Range("d2").ClearContents
    s2.Cells.Interior.ColorIndex = xlNone
    sonsat = s1.[A65536].End(3).Row
    If sonsat > 9 Then s1.Rows("10:" & sonsat).Delete
    Set s1 = Nothing
    Set s2 = Nothing
    Set s3 = Nothing
End Sub

 

[1Al2Ver]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub silfatura()
    Set s1 = Sheets("fatura")
    Set s2 = Sheets("liste")
    Set s3 = Sheets("2009 CİRO")
    sor = MsgBox("Liste Temizlenecek ! Eminmisiniz?", 52, "Uyarı !")
    If sor = vbNo Then Exit Sub
    
    Ay = Format(s1.Range("f5"), "mmmm")
    Gün = Format(s1.Range("f5"), "d")
    
    Set Bul_Ay = s3.Range("A2:IV2").Find(Ay)
    
    If Not Bul_Ay Is Nothing Then
    Bul_Gün = s3.Range(s3.Cells(2, Bul_Ay.Column), s3.Cells(35, Bul_Ay.Column)).Find(Gün).Row
    s3.Cells(Bul_Gün, Bul_Ay.Column + 2) = s3.Cells(Bul_Gün, Bul_Ay.Column + 2) + s1.Cells(65536, "F").End(3).Value
    Set Bul_Ay = Nothing
    
    Else
    
    MsgBox "2009 CİRO sayfasında " & Ay & " ayına ait bilgi girişi bulunamamıştır." & vbCrLf & _
    "Lütfen ilgili ayı ekledikten sonra tekrar deneyiniz.", vbCritical, "Dikkat !"
    Set Bul_Ay = Nothing
    Exit Sub
    End If
    
    s1.Range("c2:c6").ClearContents
    s1.Range("d2").ClearContents
    s2.Cells.Interior.ColorIndex = xlNone
    sonsat = s1.[A65536].End(3).Row
    If sonsat > 9 Then s1.Rows("10:" & sonsat).Delete
    Set s1 = Nothing
    Set s2 = Nothing
    Set s3 = Nothing
End Sub

Sayın Korhan Ayhan merhaba,

Çözüm için teşekkür ederim.

Saygılarımla.