• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Dövizli Yaşlandırma Raporu

C

cemto

Katılım
11 Mayıs 2006
Mesajlar
94
Excel Vers. ve Dili
Microsoft Office 2010
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 ,
 

Ekli dosyalar

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 BARAN' Alıntı:
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.
.
Genişletmek için tıkla ...

Ö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,
 
Çekinecek bir durum yok.
Dosyanıza bakacağım, mutlaka cevap yazarım.
 
Tekrar merhaba.
Belgede mevcut kodları aşağıdakilerle değiştirerek kullanabilirsiniz.
Rich (BB code): 
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
 
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
 
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 BARAN' Alıntı:
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.
Genişletmek için tıkla ...

Ö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
 

Ekli dosyalar

Ömer BARAN' Alıntı:
Yeni belge ekte.
VBA şifresini kaldırdım.
Ekteki belgeye, fareyle BURAYA tıklayarak da erişebilirsiniz.
.
Genişletmek için tıkla ...

ö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
 
İlgili satırı aşağıdakiyle değiştirerek deneyiniz.
Rich (BB code): 
    firmason = WorksheetFunction.Match("Alt Hesap Toplamı:", mu.Range("G" & firmailk & ":G" & enson + 4), 0) + firmailk - 3
 
Ömer BARAN' Alıntı:
İlgili satırı aşağıdakiyle değiştirerek deneyiniz.
Rich (BB code): 
    firmason = WorksheetFunction.Match("Alt Hesap Toplamı:", mu.Range("G" & firmailk & ":G" & enson + 4), 0) + firmailk - 3
Genişletmek için tıkla ...


ö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
 
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 BARAN' Alıntı:
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.
Genişletmek için tıkla ...


Ömer bey , son satıra ----------- ekleyince sorun çözüldü her şey için çok teşekkürler
 
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?
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst