Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 23-02-2017, 22:54   #1
igultekin2000
Altın Üye
 
Giriş: 05/09/2007
Şehir: istanbul
Mesaj: 530
Excel Vers. ve Dili:
ofis 2010
Varsayılan ödenmeyen faturaların tespiti

iyi akşamlar;
muhasebe programından excele aktardığım listede hesap koduna ve tutara göre ödenmeyen faturaların tespitini yapmak
http://s3.dosya.tc/server10/zhr51n/ornek.xlsx.html
yardımcı olabilecek arkadaşlara şimdiden teşekkür ederim.
igultekin2000 Çevrimiçi   Alıntı Yaparak Cevapla
Eski 23-02-2017, 23:07   #2
vardar07
Destek Ekibi
 
vardar07 kullanıcısının avatarı
 
Giriş: 19/03/2008
Şehir: Kepez / ANTALYA
Mesaj: 2,154
Excel Vers. ve Dili:
Office 2007 Enterprise Türkçe
Varsayılan

Kriter hangi sütunu alacak F mi G mi kısaca ödenip ödenmediğini nasıl anlıyoruz.
__________________
Veren El Alan Elden EVLA'dır...

Örnek excel dosyanızı,açıklamalarını da yazarak; UPTERABİT.COM, DOSYA.TC, DOSYA.CO gibi dosya paylaşım sitelerine ekleyip linkini burada bildirirseniz yardım almanız daha kolay olur.

Özel mesajlarda sorulan sorulara cevap vermiyorum.
vardar07 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 25-02-2017, 17:55   #3
igultekin2000
Altın Üye
 
Giriş: 05/09/2007
Şehir: istanbul
Mesaj: 530
Excel Vers. ve Dili:
ofis 2010
Varsayılan açıklama

Alıntı:
vardar07 tarafından gönderildi Mesajı Görüntüle
Kriter hangi sütunu alacak F mi G mi kısaca ödenip ödenmediğini nasıl anlıyoruz.
F sütunu faturadan dolayı borçlanmayı gösteriyor G sütunu ise yapılan ödemeleri.
igultekin2000 Çevrimiçi   Alıntı Yaparak Cevapla
Eski 25-02-2017, 19:13   #4
vardar07
Destek Ekibi
 
vardar07 kullanıcısının avatarı
 
Giriş: 19/03/2008
Şehir: Kepez / ANTALYA
Mesaj: 2,154
Excel Vers. ve Dili:
Office 2007 Enterprise Türkçe
Varsayılan

Deneyiniz.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub mv()
Set sh = Sheets("Sayfa1")
For i = 2 To sh.Cells(Rows.Count, "F").End(3).Row
If sh.Cells(i, "F") <> "" Then
sh.Cells(i, "L").Value = sh.Cells(i, "H").Value
sh.Cells(i, "M").Value = sh.Cells(i, "F").Value
End If
Next i
End Sub
__________________
Veren El Alan Elden EVLA'dır...

Örnek excel dosyanızı,açıklamalarını da yazarak; UPTERABİT.COM, DOSYA.TC, DOSYA.CO gibi dosya paylaşım sitelerine ekleyip linkini burada bildirirseniz yardım almanız daha kolay olur.

Özel mesajlarda sorulan sorulara cevap vermiyorum.
vardar07 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 25-02-2017, 19:36   #5
igultekin2000
Altın Üye
 
Giriş: 05/09/2007
Şehir: istanbul
Mesaj: 530
Excel Vers. ve Dili:
ofis 2010
Varsayılan bir eksiklik var galiba

Alıntı:
vardar07 tarafından gönderildi Mesajı Görüntüle
Deneyiniz.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub mv()
Set sh = Sheets("Sayfa1")
For i = 2 To sh.Cells(Rows.Count, "F").End(3).Row
If sh.Cells(i, "F") <> "" Then
sh.Cells(i, "L").Value = sh.Cells(i, "H").Value
sh.Cells(i, "M").Value = sh.Cells(i, "F").Value
End If
Next i
End Sub
makro fatura numarasını ve tutarını yan yana getiriyor, ödeme ile ilgili bir işlem yapmıyor.
igultekin2000 Çevrimiçi   Alıntı Yaparak Cevapla
Eski 26-02-2017, 02:52   #6
Ömer BARAN
Uzman
 
Giriş: 08/03/2011
Şehir: ANKARA / İSTANBUL
Mesaj: 9,676
Excel Vers. ve Dili:
Office 2013 TÜRKÇE
Varsayılan

Merhaba.

Sayın vardar'ın müsadeleriyle.

Aşağıdaki kod'u dener misiniz? (kod'u ilgili sayfanın kod böölümüne uygulayın)
.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub ODENMEYENLER_BRN()
On Error Resume Next: ActiveSheet.ShowAllData
Set wf = Application.WorksheetFunction
Columns("L:M").ClearContents
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For sat = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
    baş = wf.Match(Cells(sat, 3), Range("C:C"), 0): bit = baş + wf.CountIf(Range("C:C"), Cells(sat, 3)) - 1
    bak = wf.Sum(Range("F" & baş & ":F" & bit)) - wf.Sum(Range("G" & baş & ":G" & bit))
    sontsat = Cells(bit + 1, "G").End(3).Row + 1
        For tam = bit To sontsat Step -1
            Cells(tam, "L") = Cells(tam, "H"): Cells(tam, "M") = Cells(tam, "F"): Next
            eski = wf.Sum(Range("F" & baş & ":F" & sontsat - 1)) - wf.Sum(Range("G" & baş & ":G" & sontsat - 1))
            If eski = 0 Then GoTo 10
            For brn = baş To sontsat
                    brnbak = wf.Sum(Range("F" & baş & ":F" & brn)) - wf.Sum(Range("G" & baş & ":G" & brn))
                If brnbak = eski Then
                    günilk = wf.Match(Cells(brn, 2), Range("B" & baş & ":B" & sontsat - 1), 0) + baş - 1
                    For fsat = brn To günilk Step -1
                        If Cells(fsat, "F") > 0 Then
                            f = wf.Sum(Range("F" & fsat & ":F" & brn)) - wf.Sum(Range("G" & fsat & ":G" & brn))
                            Cells(fsat, "L") = Cells(fsat, "H"): Cells(fsat, "M") = f: End If: Next
                If f = brnbak Then GoTo 10
                End If: Next
10:    sat = baş
Next: Range("M2:M" & Cells(Rows.Count, 1).End(3).Row).NumberFormat = "#,##0.00": Columns("L:M").AutoFit
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı..", vbInformation, "..:: Ö. BARAN ::.."
End Sub
__________________
.
☾✭ İnadına TÜRKÇE ✭☽

-- Sorunuzu, gerçek belgenizle aynı yapıda ve olması gereken sonuçların elle yazıldığı örnek belge ile destekleyiniz.
-- ALTIN ÜYELİK öneriyorum. / FORUM KURALLARInı mutlaka okuyunuz.
-- ALTIN ÜYE olmayanlar, örnek belgeyi dosya.tc, dosya.co gibi bir siteye yükleyip, belgeye erişim adresini verebilir.
-- Özel mesaj ile soru sormayınız. / Geri bildirimde bulunulmayan cevaplarımı siliyorum.
Ömer BARAN Çevrimdışı   Alıntı Yaparak Cevapla
Eski 26-02-2017, 11:18   #7
igultekin2000
Altın Üye
 
Giriş: 05/09/2007
Şehir: istanbul
Mesaj: 530
Excel Vers. ve Dili:
ofis 2010
Varsayılan sonuçta hata çıkıyor.

Alıntı:
Ömer BARAN tarafından gönderildi Mesajı Görüntüle
Merhaba.

Sayın vardar'ın müsadeleriyle.

Aşağıdaki kod'u dener misiniz? (kod'u ilgili sayfanın kod böölümüne uygulayın)
.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub ODENMEYENLER_BRN()
On Error Resume Next: ActiveSheet.ShowAllData
Set wf = Application.WorksheetFunction
Columns("L:M").ClearContents
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For sat = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
    baş = wf.Match(Cells(sat, 3), Range("C:C"), 0): bit = baş + wf.CountIf(Range("C:C"), Cells(sat, 3)) - 1
    bak = wf.Sum(Range("F" & baş & ":F" & bit)) - wf.Sum(Range("G" & baş & ":G" & bit))
    sontsat = Cells(bit + 1, "G").End(3).Row + 1
        For tam = bit To sontsat Step -1
            Cells(tam, "L") = Cells(tam, "H"): Cells(tam, "M") = Cells(tam, "F"): Next
            eski = wf.Sum(Range("F" & baş & ":F" & sontsat - 1)) - wf.Sum(Range("G" & baş & ":G" & sontsat - 1))
            If eski = 0 Then GoTo 10
            For brn = baş To sontsat
                    brnbak = wf.Sum(Range("F" & baş & ":F" & brn)) - wf.Sum(Range("G" & baş & ":G" & brn))
                If brnbak = eski Then
                    günilk = wf.Match(Cells(brn, 2), Range("B" & baş & ":B" & sontsat - 1), 0) + baş - 1
                    For fsat = brn To günilk Step -1
                        If Cells(fsat, "F") > 0 Then
                            f = wf.Sum(Range("F" & fsat & ":F" & brn)) - wf.Sum(Range("G" & fsat & ":G" & brn))
                            Cells(fsat, "L") = Cells(fsat, "H"): Cells(fsat, "M") = f: End If: Next
                If f = brnbak Then GoTo 10
                End If: Next
10:    sat = baş
Next: Range("M2:M" & Cells(Rows.Count, 1).End(3).Row).NumberFormat = "#,##0.00": Columns("L:M").AutoFit
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı..", vbInformation, "..:: Ö. BARAN ::.."
End Sub
makroyu uyguladım ama bazı durumda sonucu ulaştım ama eke yüklediğim gibi durum olduğunda hatalı sonuç veriyor. http://s6.dosya.tc/server8/k1778y/ornek2.rar.html
ilginize teşekkürler.
igultekin2000 Çevrimiçi   Alıntı Yaparak Cevapla
Eski 26-02-2017, 14:29   #8
Ömer BARAN
Uzman
 
Giriş: 08/03/2011
Şehir: ANKARA / İSTANBUL
Mesaj: 9,676
Excel Vers. ve Dili:
Office 2013 TÜRKÇE
Varsayılan

Merhaba.

Bir de aşağıdaki kod'u dener misiniz?
İlk örnek dosyanıza göre önceki cevabımdaki kod da aşağıdaki de sonuç alınmasını sağlıyor.

Son eklediğiniz belgede faturası olmayan ödeme var gibi görüyorum (7'nci satırdaki 500,00),
bu durumda ne yapılacağı çok net değil doğrusu.


Aslına bakarsanız mantığın şu şekilde olması lazım;
-- faturalar borç kaydedilir,
-- ödemeler, o ana kadar oluşan faturalardan ödenmemiş ilkine ait olmalıdır (FİFO gibi).


Ama ben, isteğinizin "tarih / müşteri kodu kriterine göre işlem yapılması" şeklinde olduğunu düşünerek
kod oluşturdum (hem gönderdiğim ilk kod, hem de aşağıdaki kod bu şekilde)


İstediğiniz sonucu alamazsanız; sadece sonuç alamadığınız satırları değil,
sonuç alamadığınız belgedeki tüm listeyi ekleyiniz.
.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub ODENMEYENLER_BRN2()
On Error Resume Next: ActiveSheet.ShowAllData
Set wf = Application.WorksheetFunction
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Columns("L:N").Delete: Columns("F:G").Copy [M1]
For sat = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
    If Cells(sat, 3) <> Cells(sat + 1, 3) Then
    kodson = sat: kodilk = wf.Match(Cells(sat, 3), Range("C:C"), 0)
        For satt = kodilk To kodson
        If Cells(satt, "N") > 0 Then
            If wf.CountIf(Range("M" & kodilk & ":M" & satt), Cells(satt, "N")) > 0 Then
                hedefsat = wf.Match(Cells(satt, "N"), Range("M" & kodilk & ":M" & satt), 0) + kodilk - 1
                Cells(hedefsat, "M") = "": Cells(satt, "N") = ""
            End If: End If: Next: End If: Next
For sat = Cells(Rows.Count, 1).End(3).Row + 1 To 2 Step -1
    If Cells(sat, "N") > 0 Then
        For satt = sat To 2 Step -1
            If Cells(satt, 2) <> Cells(sat - 1, 2) Then
                borc = wf.Sum(Range("M" & satt + 1 & ":M" & sat))
                alacak = wf.Sum(Range("N" & satt + 1 & ":N" & sat))
                If borc = alacak Then
                    Range("N" & satt + 1 & ":M" & sat) = ""
                ElseIf borc > alacak Then
                    Range("M" & satt + 1) = borc - alacak: Range("N" & satt + 1 & ":N" & sat) = ""
                    Exit For: End If: End If: Next: End If: Next
For sat = 2 To Cells(Rows.Count, 1).End(3).Row
    If Cells(sat, "M") > 0 Then Cells(sat, "L") = Cells(sat, "H")
Next: Columns("N").Delete
Range("A1:M1").AutoFilter: Range("A1:M1").AutoFilter
ActiveSheet.Range("$A$1:$M$717").AutoFilter Field:=12, Criteria1:="<>"
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı..", vbInformation, "..:: Ö. BARAN ::.."
End Sub
__________________
.
☾✭ İnadına TÜRKÇE ✭☽

-- Sorunuzu, gerçek belgenizle aynı yapıda ve olması gereken sonuçların elle yazıldığı örnek belge ile destekleyiniz.
-- ALTIN ÜYELİK öneriyorum. / FORUM KURALLARInı mutlaka okuyunuz.
-- ALTIN ÜYE olmayanlar, örnek belgeyi dosya.tc, dosya.co gibi bir siteye yükleyip, belgeye erişim adresini verebilir.
-- Özel mesaj ile soru sormayınız. / Geri bildirimde bulunulmayan cevaplarımı siliyorum.
Ömer BARAN Çevrimdışı   Alıntı Yaparak Cevapla
Eski 26-02-2017, 14:33   #9
vardar07
Destek Ekibi
 
vardar07 kullanıcısının avatarı
 
Giriş: 19/03/2008
Şehir: Kepez / ANTALYA
Mesaj: 2,154
Excel Vers. ve Dili:
Office 2007 Enterprise Türkçe
Varsayılan

Alıntı:
igultekin2000 tarafından gönderildi Mesajı Görüntüle
makro fatura numarasını ve tutarını yan yana getiriyor, ödeme ile ilgili bir işlem yapmıyor.
Dosyanızdaki açıklamanız: "Fatura ve ödemelerin programdan çıkmış hali. Benim yapak istediğim ödemesi yapılmamış faturaları makro ile tespit etmek. Ödenmeyen faturaların numarasını ve tutarın L ve M sütununa yazdırmak." yukardaki isteğiniz sonradan çıktı galiba. Ödeme ile ilgili nasıl bir işlem yapacak. Sizin ne yapmak istediğinizi bilmediğimiz için sizin isteklerinizi net ve eksiksiz yazmanız lazım. Mesela Ftno:50620 Tutar: 800,00 Ödeme: ???? ne olacak.
__________________
Veren El Alan Elden EVLA'dır...

Örnek excel dosyanızı,açıklamalarını da yazarak; UPTERABİT.COM, DOSYA.TC, DOSYA.CO gibi dosya paylaşım sitelerine ekleyip linkini burada bildirirseniz yardım almanız daha kolay olur.

Özel mesajlarda sorulan sorulara cevap vermiyorum.
vardar07 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 26-02-2017, 15:12   #10
igultekin2000
Altın Üye
 
Giriş: 05/09/2007
Şehir: istanbul
Mesaj: 530
Excel Vers. ve Dili:
ofis 2010
Varsayılan ilave açıklama

Alıntı:
vardar07 tarafından gönderildi Mesajı Görüntüle
Dosyanızdaki açıklamanız: "Fatura ve ödemelerin programdan çıkmış hali. Benim yapak istediğim ödemesi yapılmamış faturaları makro ile tespit etmek. Ödenmeyen faturaların numarasını ve tutarın L ve M sütununa yazdırmak." yukardaki isteğiniz sonradan çıktı galiba. Ödeme ile ilgili nasıl bir işlem yapacak. Sizin ne yapmak istediğinizi bilmediğimiz için sizin isteklerinizi net ve eksiksiz yazmanız lazım. Mesela Ftno:50620 Tutar: 800,00 Ödeme: ???? ne olacak.
http://s9.dosya.tc/server2/cduz73/ornek.rar.html

evet konu zihnimde olduğu için ifade biraz eksik oluyor. kısaca izah edecek olursam. liste datasoft programından çıktığı haliyle, C Sütunu müşterinin hesap kodunu, F sütunu ise o müşteriye kesilen fatura tutarını, H sütunu ise ilgili faturanın numarasını gösteriyor. G sütunu ise o firmadan yapılan tahsilatı gösteriyor. yapılan ödemelerin ilk faturaya sayılmasını sağlayarak aşağı doğru ödenmeyen faturaları tespit etmek. formda yaşlandırma şeklinde örnek buldum ama o da mesela fatura tutarı 800 , ödeme 900 yapıldığı zaman hata veriyor.
igultekin2000 Çevrimiçi   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 19:51


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Karton Bardak- Çorlu Dil Konuşma Terapisti- Çorlu Dil Konuşma Terapisti- Çorlu Konuşma Terapisti- Çorlu Konuşma Terapisti- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Çorlu- Çorlu Araç Takip- Çorlu Su Arıtma- Gebze Emlak- Rampa- Rotary- Çorlu İnternet Sitesi- Çorlu Sürücü Kursu- Çorlu Sürücü Kursu- Şişli Avukat- Edirne Serbest Muhasebeci- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta- Kağıt Bardak- Kağıt Bardak- Kaplan Tekstil- Çorlu Perde- Çorlu Perde- Çorlu Havuz- Çorlu Havuz- Makina- Danışmazlar- Çorlu Perde Yıkama- Çorlu Perde Yıkama- Okul Danışmanlık- Çorlu Ayakkabı- İzmit Sigorta- ADR'li taşıma kabı imalatı- Mekanik Tesisat- Çorlu Grafik Tasarım-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden