Dövizli Yaşlandırma Raporu

[cemto]

Arkadaşlar merhaba , önceden tl yaşlandırma raporu gerekiyordu sitede sağ olsun arkadaşlar yardımcı olmuştu , şimdi dövizli yaşlandırma raporu yapmamız lazım ileri seviye excel bilgimiz olmadığı tıkandık
* Örnek olması için daha önce yapılan tl yaşlandırma raporunu ekledim,
* Dövizli yaşlandırma raporunda aynı sistemle * son bakiye üzerinden giderek faturanın kaç gün geciktiğini ilgili kutuya aktarılması ve rapor ekranında yanın da döviz cinsini yazması şimdilik usd ve euro var sadece

ilgilenen arkadaşlara şimdiden teşekkür ederim ,

 

[Ömer BARAN]

Merhaba.

İsim hatırlamamışsanız bile en azından arkadaşlar şeklinde çoğul eki olmasaydı keşke.
Zira mevcut kod'u tek başıma yazdığımdan eminim.
.

 

[cemto]

Merhaba.

İsim hatırlamamışsanız bile en azından arkadaşlar şeklinde çoğul eki olmasaydı keşke.
Zira mevcut kod'u tek başıma yazdığımdan eminim.
.

Ömer bey merhaba , sitede yeni tarihli yardım ettiğiniz dosyaları gördüm direk mesaj atacaktım size , bir kere birine yardım edersin oda sürekli peşinden ayrılmaz konumuna düşmemek için birde ilk dosyada çok yardımınız dokundu ikinciyi istemeye çekindim açıkcası , bir arkadaş yardım etti kaba olabileceğini düşünerek arkadaşlar dedim kusura bakmayın lütfen,

 

[Ömer BARAN]

Çekinecek bir durum yok.
Dosyanıza bakacağım, mutlaka cevap yazarım.

 

[Ömer BARAN]

Tekrar merhaba.
Belgede mevcut kodları aşağıdakilerle değiştirerek kullanabilirsiniz.

Sub SIL_BRN()
If Sheets("RAPOR").[A65536].End(3).Row > 3 Then _
    Sheets("RAPOR").Range("A4:L" & Sheets("RAPOR").[A65536].End(3).Row + 1).ClearContents
Sheets("RAPOR").Range("A:A").ClearComments
End Sub


Sub CARI_BRN2()
Set ra = Sheets("RAPOR"): Set mu = Sheets("muavin"): Call SIL_BRN
enson = mu.Cells(Rows.Count, "A").End(3).Row
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual

For satir = 3 To enson
    firmailk = WorksheetFunction.Match("Alt Hesap Kodu :", mu.Range("A" & satir & ":A" & Rows.Count), 0) + satir + 1
    If WorksheetFunction.CountIf(mu.Range("A" & firmailk & ":A" & enson), "------------") = 0 Then
        firmason = enson
    Else
        firmason = WorksheetFunction.Match("------------", mu.Range("A" & firmailk & ":A" & enson), 0) + firmailk - 4
    End If
    If mu.Cells(firmason, "F") = "" Then firmason = firmason - 1
    If mu.Cells(firmason, 12) = "A" Or mu.Cells(firmason, 11) = "" Then GoTo bitti
    firmabakiye = mu.Cells(firmason, 11)
    brn = ra.[A65536].End(3).Row + 1
    ra.Cells(brn, 12) = firmabakiye
    ra.Cells(brn, 1) = UCase(mu.Cells(firmailk - 2, "D"))
    ra.Cells(brn, 2) = mu.Cells(firmailk, 8)
        With ra.Cells(brn, 1)
            .AddComment: .Comment.Text Text:="" & mu.Cells(firmailk - 2, 2).Value & ""
            .Comment.Shape.TextFrame.AutoSize = True
        End With
    For sat = firmason To firmailk Step -1
        If mu.Cells(sat, 9) > 0 Or mu.Cells(sat, 10) > 0 Then
            satirtutarı = 0 + mu.Cells(sat, 9)
            If satirtutarı = 0 Then GoTo 20
            yazilan = WorksheetFunction.Sum(ra.Range("C" & brn & ":K" & brn))
            If yazilan = 0 + ra.Cells(brn, 12) Then GoTo bitti
            yazilacak = WorksheetFunction.Min(firmabakiye - yazilan, satirtutarı)
            gfark = Date - CDate(mu.Cells(sat, 1))
                If gfark > 360 Then: rasut = 11
                If gfark > 210 Then: rasut = 10
                If gfark <= 210 Then: rasut = Int(gfark / 30) + 3
            ra.Cells(brn, rasut) = ra.Cells(brn, rasut) + yazilacak
            If mu.Cells(sat, 9) > firmabakiye Then _
                ra.Cells(ra.[A65536].End(3).Row, rasut) = borç + ra.Cells(ra.[A65536].End(3).Row, rasut)
        End If
20 Next
bitti: satir = firmason
Next: ra.Activate
Application.Calculation = xlCalculationAutomatic: Application.ScreenUpdating = True
MsgBox "İŞLEM TAMAM, SONUÇLARI KONTROL EDİNİZ.."
End Sub

 

[UluocakYasin]

Merhabalar,
Çalışmayı gördüm işime yarayabileceğini düşündüm fakat arkadaş ekteki dosyanın VBA kısmına password koymuş yeni kodu uygulayamadım. Şifreyi kaldırıp tekrar örnek dosyayı koyabilirseniz bizlerde faydalanalım

 

[cemto]

Çekinecek bir durum yok.
Dosyanıza bakacağım, mutlaka cevap yazarım.

Teşekkürler ömer bey , vba dosyasına açtığımda şifre istiyor vba procet yazan kısıma yapıştıracağız değil mi

 

[Ömer BARAN]

Cep telefonundan yazıyorum.
Yanlış hatıramıyorsam, vba kısmının şifresi sizin forumdaki kullanıcı adınız idi.
Verdiğim kodu, Module deki eski kodların yerine yapıştıracaksınız.
Sayfadaki düğmelere sağ tıklayıp MAKRO ATA yı seçerek yeni kodlarla bağlantı kurmanız gerekebilir.

 

[cemto]

Cep telefonundan yazıyorum.
Yanlış hatıramıyorsam, vba kısmının şifresi sizin forumdaki kullanıcı adınız idi.
Verdiğim kodu, Module deki eski kodların yerine yapıştıracaksınız.
Sayfadaki düğmelere sağ tıklayıp MAKRO ATA yı seçerek yeni kodlarla bağlantı kurmanız gerekebilir.

Ömer bey , verdiğiniz kodu ekledim çalışıyor teşekkür ederim , birkaç sorun var dosyayı ekliyorum müsait olduğunuzda baka bilirseniz sevinirim,

* raporda ilk satırda göreceğiniz üzere muavin de sadece devir rakamı olanlarda hesaplama yapmıyor genel toplamda döviz bakiye yazıyor

* 0 bakiyeler de rapora aktarma şeklinde bir kod ekleye bilir miyiz

* son olarak ta muavin sayfasında ilk satırda Yed XXX bunu rapora almıyor

 

[Ömer BARAN]

Yeni belge ekte.
VBA şifresini kaldırdım.
Ekteki belgeye, fareyle BURAYA tıklayarak da erişebilirsiniz.
.

 

[cemto]

Yeni belge ekte.
VBA şifresini kaldırdım.
Ekteki belgeye, fareyle BURAYA tıklayarak da erişebilirsiniz.
.

ömer bey , dosyayı indirdim muavini dökümü kopyaladığımda aşağıdaki hatayı veriyor

" run-time error '1004': worksheetfunction sınıfının match özelliği alınamıyor "

Debug dediğimde

sarı işaretle firmason = WorksheetFunction.Match("------------", mu.Range("A" & firmailk & ":A" & enson + 4), 0) + firmailk - 4 işaretli gösteriyor

 

[Ömer BARAN]

İlgili satırı aşağıdakiyle değiştirerek deneyiniz.

    firmason = WorksheetFunction.Match("Alt Hesap Toplamı:", mu.Range("G" & firmailk & ":G" & enson + 4), 0) + firmailk - 3

 

[cemto]

İlgili satırı aşağıdakiyle değiştirerek deneyiniz.

    firmason = WorksheetFunction.Match("Alt Hesap Toplamı:", mu.Range("G" & firmailk & ":G" & enson + 4), 0) + firmailk - 3

ömer bey satırı değiştirdim bu sefer yine aynı hatayı yeni kodla veriyor


Sub CARI_BRN2()
Set ra = Sheets("RAPOR"): Set mu = Sheets("muavin"): Call SIL_BRN
enson = mu.Cells(Rows.Count, "A").End(3).Row - 3
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
If mu.AutoFilterMode = True Then mu.AutoFilterMode = False
For satir = 2 To enson
firmailk = WorksheetFunction.Match("Alt Hesap Kodu :", mu.Range("A" & satir & ":A" & Rows.Count), 0) + satir + 1
firmason = WorksheetFunction.Match("Alt Hesap Toplamı:", mu.Range("G" & firmailk & ":G" & enson + 4), 0) + firmailk - 3
firmabakiye = 0 + mu.Cells(firmason, 11)
brn = ra.[A65536].End(3).Row + 1
ra.Cells(brn, 12) = firmabakiye
ra.Cells(brn, 1) = UCase(mu.Cells(firmailk - 2, "D"))
ra.Cells(brn, 2) = mu.Cells(firmailk, 8)
With ra.Cells(brn, 1)
.AddComment: .Comment.Text Text:="" & mu.Cells(firmailk - 2, 2).Value & ""
.Comment.Shape.TextFrame.AutoSize = True
End With
For sat = firmason To firmailk Step -1
If mu.Cells(sat, 9) > 0 Or mu.Cells(sat, 10) > 0 Then
satirtutarı = 0 + mu.Cells(sat, 9)
If satirtutarı = 0 Then GoTo 20
yazilan = WorksheetFunction.Sum(ra.Range("C" & brn & ":K" & brn))
If yazilan = 0 + ra.Cells(brn, 12) Then GoTo bitti
yazilacak = WorksheetFunction.Min(firmabakiye - yazilan, satirtutarı)
gfark = Date - CDate(mu.Cells(sat, 1))
If gfark > 360 Then: rasut = 11
If gfark > 210 Then: rasut = 10
If gfark <= 210 Then: rasut = Int(gfark / 30) + 3
ra.Cells(brn, rasut) = ra.Cells(brn, rasut) + yazilacak
If mu.Cells(sat, 9) > firmabakiye Then _
ra.Cells(ra.[A65536].End(3).Row, rasut) = borç + ra.Cells(ra.[A65536].End(3).Row, rasut)
End If
20 Next
bitti: satir = firmason
Next: ra.Activate
Application.Calculation = xlCalculationAutomatic: Application.ScreenUpdating = True
MsgBox "İŞLEM TAMAM, SONUÇLARI KONTROL EDİNİZ.."
End Sub

 

[Ömer BARAN]

Yapıştırdığınız verinin örnek belgedekiyle aynı yapıda olduğuna emin misiniz?
Örneğin veri başlangıç satırı aynı mıdır? Firma satırları arasında ve verilerin en sonunda ----------- gibi bir satır var mıdır?
Bir de For döngüsünü 2'değil, 1'den başlatarak deneyin.

Orijinal belgedeki verilerinizin durumunu görmek lazım.

 

[cemto]

Yapıştırdığınız verinin örnek belgedekiyle aynı yapıda olduğuna emin misiniz?
Örneğin veri başlangıç satırı aynı mıdır? Firma satırları arasında ve verilerin en sonunda ----------- gibi bir satır var mıdır?
Bir de For döngüsünü 2'değil, 1'den başlatarak deneyin.

Orijinal belgedeki verilerinizin durumunu görmek lazım.

Ömer bey , son satıra ----------- ekleyince sorun çözüldü her şey için çok teşekkürler

 

[erdalbakkalbenim]

Merhabalar, yukarıda çözümü yer alan yaşlandırma çalışmasını, kodlama konusundaki sınırlı bilgimle, ihtiyaçlarıma göre biraz farklılaştırmaya çalışıyorum. Ekli çalışmada yer alan "Deneme Muavin" isimli sheetteki şekilde bir veri üzerinden makroyu çalıştırmak istiyorum ama mevcut bilgimle başaramadım. Bu konuda yardımcı olabilir misiniz rica etsem?