Fatura Sıra No Takip Makrosu

ERMAN SAYINALP · 1 Ekim 2015

Selam,

Bir Excel Kitabında herbiri ayrı sheet'te olmak üzere Müşteri Cari Hesapları takip edilmektedir.
Sheet'lerin bir sütununda FATURA NUMARA'ları bulunmaktadır.
Pazarlama elemanları, kendilerine verilen Fatura Koçanlarından Bayilere Fatura kesmektedirler.
Birçok Bayi ve birçok seride Fatura Koçanı bulunmakta ve fatura kesilmektedir.
Bu faturalarda ilgili Cari Hesaplara işlenmektedir.

Sorum; Ayrı bir kontrol Sayfasında makro yardımıyla atlayan (kesilmeyen yada işlenmeyen) Fatura/Faturaları bulunabilmesine yöneliktir.

Örneğin; 10 Cari Hesaba 3 ayrı seri no'dan Faturalar kesilmiş olsun, Fatura Seri No'ları da, 147501-147600 (100), 154301-154400 (100), 162901-163000 (100) olsun, bu serilerden, 147563, 154322, 162915 nolu faturalar bir şekilde Cari Hesaplara kaydedilmemiş ise, sözkonusu makro yardımıyla bunlar tespit edilebilsin. (Cari Hesap Sayısının yüzlerce, Fatura Sayısının binlerce ve işlenmeyen faturaların onlarca olduğu düşünüldüğünde ne kadar gerekli olduğunu tahmin edersiniz)

Yardımlarınız için şimdiden teşekkür ederim.

Ömer BARAN · 19 Ekim 2015

Örnek dosya lütfen.

Ayrıca UserForm kullanılarak Sayın Korhan AYHAN'ın hazırladığı bir dosya hatırlıyorum, sanırım adı ADİSYON TAKİP idi.

Örnek bir uygulamadır. Geçmişte bakmıştım. Forumda arama yapınız.

ERMAN SAYINALP · 19 Ekim 2015

Örnek Dosya Ektedir

Ekte gönderiyorum.

Ömer BARAN · 19 Ekim 2015

EKSİK FATURALAR sayfasının kod bölümüne aşağıdaki kod'u yapıştırın.
(alt taraftan EKSİK FATURALAR sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçtiğinizde karşınıza gelen ekranın sağ tarafındaki boş bölüme)

EKSİK FATURALAR sayfasına bir DÜĞME/ŞEKİL ekleyin ve bu düğmeye fareyle sağ tıklayıp MAKRO ATAyı seçin.
Açılan küçük ekranda sol tarafta EKSİKBUL'u seçip işlemi onaylayın. Sonra bu düğmeye tıklayın.

Kod:

Sub EKSİKBUL()
Sheets("EKSİK FATURALAR").Cells.ClearContents
For b = 1 To 3
    sayfa = "Sayfa" & b
Sheets("EKSİK FATURALAR").Cells(1, b) = sayfa
    For a = Sheets(sayfa).Cells(1, 1) To Sheets(sayfa).Cells(Sheets(sayfa).[A65536].End(3).Row, 1)
        If WorksheetFunction.CountIf(Sheets(sayfa).Range("A:A"), a) = 1 Then GoTo 10
    Sheets("EKSİK FATURALAR").Cells(Sheets("EKSİK FATURALAR").Cells(65536, b).End(3).Row + 1, b) = a
10: Next
Next
End Sub

ERMAN SAYINALP · 19 Ekim 2015

Emeğinize teşekkür ederek başlayıp, sorumu detaylandırmak isterim.

Her Sayfada Fatura Numaraları aynı SERİ'den olsaydı sizin yaptığınız KOD'lamayla kolayca sonuç alabilecektik.

Oysa her sayfada Fatura Numaraları KARIŞIK SERİ'lerden oluştuğu için durum biraz karışık hale geliyor.

Örneğin; Tüm Sayfalara 145xxx, 163xxx, 178xxx, 232xxx, 353xxx .... serilerden Karışık halde dağılmış durumda olduğunda durumu çözmek için ne yapılabilir.

Yani, belki veri olarak, Fatura Ciltlerinin Numara aralığı ön bilgi olarak girilmesi gerekecektir. Programa şu soruyu soruyoruz;

"Bana, 145501-145600, 163201-163300, 178401-178500, ...... aralığında kesilen faturalardan tüm Çalışma Sayfalarına karışık olarak dağılmış olanları araştır, EKSİK OLANLARI GÖSTER"

dediğimizde bize sonuç gösterecek bir MAKRO yazılımı. Elbette olabildiği ölçüde, zahmetlerinize teşekkürler.

halit3 · 19 Ekim 2015

VWJETTA' Alıntı:
Emeğinize teşekkür ederek başlayıp, sorumu detaylandırmak isterim.

Her Sayfada Fatura Numaraları aynı SERİ'den olsaydı sizin yaptığınız KOD'lamayla kolayca sonuç alabilecektik.

Oysa her sayfada Fatura Numaraları KARIŞIK SERİ'lerden oluştuğu için durum biraz karışık hale geliyor.

Örneğin; Tüm Sayfalara 145xxx, 163xxx, 178xxx, 232xxx, 353xxx .... serilerden Karışık halde dağılmış durumda olduğunda durumu çözmek için ne yapılabilir.

Yani, belki veri olarak, Fatura Ciltlerinin Numara aralığı ön bilgi olarak girilmesi gerekecektir. Programa şu soruyu soruyoruz;

"Bana, 145501-145600, 163201-163300, 178401-178500, ...... aralığında kesilen faturalardan tüm Çalışma Sayfalarına karışık olarak dağılmış olanları araştır, EKSİK OLANLARI GÖSTER"

dediğimizde bize sonuç gösterecek bir MAKRO yazılımı. Elbette olabildiği ölçüde, zahmetlerinize teşekkürler.

Örnek dosyanıza göre bu kodu bir deneyiniz.

kod:

Kod:

Sub arama1()
Sayfa = "EKSİK FATURALAR"

sat = 1

For i = 1 To ActiveWorkbook.Sheets.Count
If Sheets(i).Name <> Sayfa Then
son = Worksheets(Sheets(i).Name).Cells(Rows.Count, "A").End(3).Row
bas = Worksheets(Sheets(i).Name).Cells(1, 1).Value
bit = Worksheets(Sheets(i).Name).Cells(1, son).Value

For r = 1 To son
aranan = bas + r - 1
If aranan = Worksheets(Sheets(i).Name).Cells(r, 1).Value Then
Else
Worksheets(Sayfa).Cells(sat, 1).Value = aranan
Worksheets(Sayfa).Cells(sat, 2).Value = Sheets(i).Name
sat = sat + 1
End If
Next

End If
Next
MsgBox "işlem tamam"
End Sub

halit3 · 19 Ekim 2015

Veya

Kod:

Sub arama2()
Sayfa = "EKSİK FATURALAR"
sat = 1
For i = 1 To ActiveWorkbook.Sheets.Count
If Sheets(i).Name <> Sayfa Then
son = Worksheets(Sheets(i).Name).Cells(Rows.Count, "A").End(3).Row
bas = WorksheetFunction.Min(Worksheets(Sheets(i).Name).Range(Worksheets(Sheets(i).Name).Cells(1, 1), Worksheets(Sheets(i).Name).Cells(1, son)))
bit = WorksheetFunction.Max(Worksheets(Sheets(i).Name).Range(Worksheets(Sheets(i).Name).Cells(1, 1), Worksheets(Sheets(i).Name).Cells(1, son)))
For r = 1 To son
aranan = bas + r - 1
If aranan = Worksheets(Sheets(i).Name).Cells(r, 1).Value Then
Else
Worksheets(Sayfa).Cells(sat, 1).Value = aranan
Worksheets(Sayfa).Cells(sat, 2).Value = Sheets(i).Name
sat = sat + 1
End If
Next

End If
Next
MsgBox "işlem tamam"
End Sub

halit3 · 19 Ekim 2015

Veya

Kod:

Sub arama3()
Sayfa = "EKSİK FATURALAR"
sat = 1

For i = 1 To ActiveWorkbook.Sheets.Count
If Sheets(i).Name <> Sayfa Then
son = Worksheets(Sheets(i).Name).Cells(Rows.Count, "A").End(3).Row
bas = WorksheetFunction.Min(Worksheets(Sheets(i).Name).Range(Worksheets(Sheets(i).Name).Cells(1, 1), Worksheets(Sheets(i).Name).Cells(1, son)))
bit = WorksheetFunction.Max(Worksheets(Sheets(i).Name).Range(Worksheets(Sheets(i).Name).Cells(1, 1), Worksheets(Sheets(i).Name).Cells(1, son)))

For j = 1 To son
aranan = bas + j - 1
say = 0
For r = 1 To son
If aranan = Worksheets(Sheets(i).Name).Cells(r, 1).Value Then
say = 1
Exit For
End If
Next

If say = 0 Then
Worksheets(Sayfa).Cells(sat, 1).Value = aranan
Worksheets(Sayfa).Cells(sat, 2).Value = Sheets(i).Name
sat = sat + 1
End If
Next

End If
Next
MsgBox "işlem tamam"
End Sub

halit3 · 19 Ekim 2015

Veya

Kod:

Sub arama4()
Sayfa = "EKSİK FATURALAR"
sat = 1

For i = 1 To ActiveWorkbook.Sheets.Count
If Sheets(i).Name <> Sayfa Then
son = Worksheets(Sheets(i).Name).Cells(Rows.Count, "A").End(3).Row
bas = Worksheets(Sheets(i).Name).Cells(1, 1).Value
bit = Worksheets(Sheets(i).Name).Cells(1, son).Value
For j = 1 To son
aranan = bas + j - 1
say = 0
For r = 1 To son
If aranan = Worksheets(Sheets(i).Name).Cells(r, 1).Value Then
say = 1
Exit For
End If
Next

If say = 0 Then
Worksheets(Sayfa).Cells(sat, 1).Value = aranan
Worksheets(Sayfa).Cells(sat, 2).Value = Sheets(i).Name
sat = sat + 1
End If
Next

End If
Next
MsgBox "işlem tamam"
End Sub

ERMAN SAYINALP · 19 Ekim 2015

Sevgili Halit Özdemir ve Ömer Baran Üstadlar,

Benim için çok zahmetler verdiniz, ancak sanırım ben yeterince açıklayamadım. Bu bakımdan ekte Uygulamalı olarak derdimi anlatmaya çalıştım ve sizden çözüm ricasında bulunuyorum, elbette hoşgörünüze sığınarak.

Ömer BARAN · 19 Ekim 2015

Merhaba, aşağıdaki kod'u kullanabilirsiniz.
Yeni cilt seri numaralarını aynı sütunda boşluksuz olarak ekleyebilirsiniz.

Kod:

Sub [B][COLOR="Red"]EKSİKFAZLABUL[/COLOR][/B]()
Dim EKS As Worksheet: Set EKS = Sheets("EKSİK FATURALAR")

EKS.Range("C3:D" & EKS.[D65536].End(3).Row).ClearContents
EKS.Cells(2, 4) = "EKSİKLER"
EKS.Cells(2, 3) = "CİLT DIŞI"
   
   For t = 3 To EKS.[E65536].End(3).Row
        ilk = 0 + Left(EKS.Cells(t, 5), 4)
        son = ilk + 49
            For a = ilk To son
                bir = 0
                For b = 1 To 3
                    sayfa = "Sayfa" & b
                    sayı = WorksheetFunction.CountIf(Sheets(sayfa).Range("A:A"), a)
                    If sayı > 0 Then GoTo 10
                Next
                EKS.Cells(EKS.Cells(65536, 4).End(3).Row + 1, 4) = a
10:         Next
    Next
MsgBox "TOPLAM:  " & EKS.[D65536].End(3).Row - 2 & "  ADET EKSİK BELGE VAR"

[COLOR="Lime"][B]'***Buradan sonrazı FAZLALIK için***[/B][/COLOR]

For s = 1 To 3
  syf = "Sayfa" & s
    For g = 1 To Sheets(syf).[A65536].End(3).Row
        For h = 3 To EKS.[E65536].End(3).Row
            For cilt = 3 To EKS.[E65536].End(3).Row
              ilk = 0 + Left(EKS.Cells(cilt, 5), 4)
              son = ilk + 49
                 If Sheets(syf).Cells(g, 1) >= ilk And Sheets(syf).Cells(g, 1) <= son Then GoTo 50
            Next
        Next
   EKS.Cells(EKS.[C65536].End(3).Row + 1, 3) = Sheets(syf).Cells(g, 1)
50
    Next
Next
If EKS.[C65536].End(3).Row > 2 Then
MsgBox "TOPLAM:  " & EKS.[C65536].End(3).Row - 2 & "  ADET CİLT DIŞI BELGE VAR"
End If

End Sub

NOT: Önceki kod'da değişiklik yapılmıştır, kullanmışsanız hatalı olanın yerine buradaki kodları kullanabilirsiniz.
.

ERMAN SAYINALP · 19 Ekim 2015

Azimliyim, olacak bu iş !

Sevgili Ömer Baran Üstad,

Kodlamanızı uyguluyorum, ancak netice alamıyorum. Uygulama ektedir.

Örnek olsun diye çok küçülttüğüm veritabanımızda, Toplam 150 adet Fatura kesilmiş, bunlardan 15 tanesi kayıp (E Sütununda listelenmiş olanlar). Bu kayıpları test etmek amacıyla ben oraya yazdım, oysa istediğim bunların MAKRO Yardımıyla bulunmasıdır.

Öte yandan, sizin kodlamanız uygulandığında, 670 gibi alakasız bir sayıda eksik fatura gösteriyor. Bizim istediğimiz ise 15 adet Faturayı listelemesidir.

Anlatamadığımı düşündüğünüz yerlerde soru-cevap yaparak yönlendirici olabilirim. Yeter ki bu konuda yardımınızı esirgemeyin.

Teşekkürler.

Ömer BARAN · 19 Ekim 2015

Mevcut kod'da değişiklik yaparak yeniledim ve dosyaya uyguladım.
Hem eksik belge ve hem de yazılan cilt dışında belge varsa ikisini de listeler.
Bir önceki cevaptaki kod'u şimdi güncelliyorum.

ERMAN SAYINALP · 19 Ekim 2015

Sevgili Ömer Baran Üstad,

Şimdi ben size nasıl teşekkür etmeliyim ? Emeğinize aklınıza sağlık...
İstediğim gibi ve hatta fazlası ile olmuş, zira KAYIT DIŞI olanları da bulması muhteşem. Minnettarım.

Ekstra 2 soru ile bitirelim;
1- Ciltler, 100'lük seri ise "son = ilk + 49" bölümünde sanırım "99" olarak düzeltme yapıcam.
2- Sayfa Adlarını Sayfa1, Sayfa2 diye değil de farklı İsimlerde kullanırsam sanırım sorun olmayacak !

Sevgi ve saygıyla...

halit3 · 19 Ekim 2015

Ekli dosyayı irdeleyiniz.

not:Ciltleri E ve F sütununa başlangıç ve bitişlerini yazınız.

Ömer BARAN · 19 Ekim 2015

VWJETTA' Alıntı:
Sevgili Ömer Baran Üstad,

Şimdi ben size nasıl teşekkür etmeliyim ? Emeğinize aklınıza sağlık...
İstediğim gibi ve hatta fazlası ile olmuş, zira KAYIT DIŞI olanları da bulması muhteşem. Minnettarım.

Ekstra 2 soru ile bitirelim;
1- Ciltler, 100'lük seri ise "son = ilk + 49" bölümünde sanırım "99" olarak düzeltme yapıcam.
2- Sayfa Adlarını Sayfa1, Sayfa2 diye değil de farklı İsimlerde kullanırsam sanırım sorun olmayacak !

Sevgi ve saygıyla...

Birkaç hususu söyleyeyim.
-- Ciltlerin son seri numaralarını yok saydım, zira cilt stadart 50 yaprak.
Hesaplama cilt verisindeki --- karakterine göre soldan sayıları alıp ilk olarak kullanıyor ve +49'a kadar döngü çalışıyor.

-- Sayfa adlarına gelince, başlangıcı standart kelime (örneğimizde Sayfa) ve devamında da 1'er artarak giden sayısal veri şeklinde olunca For..Next döngüsü için çok pratik oluyor, diğer türlü olunca (sitede örnekleri vardır mutlaka) döngüyü belgedeki tüm sayfalar diye kurup, sonuçların yazıldığı sayfa adı hariç diye koşul ekleyerek de yapılabilir sanırım, böyle bir döngü ben şimdiye kadar hiç yazmadım doğrusu, belki pratik düşünerek şöyle yapılabilir, bir sütuna arama yapılacak sayfaların ad listesi yapılıp, oraya atfen de döngü kurulabilir sanırım.

Kod olaylarıyla uğraşmaya (yazmak bakımından) daha yeni başladım, şu konu için hadi derseniz beni aşma ihtimali çok yüksek doğrusu.

Sanırım meslek mensubusunuz doğru mudur?
Sağlıcakla.

Sonradan ilave not: Bakın bu tür konuların sitedeki en iyilerinden diyebileceğim Sayın ÖZDEMİR'dir ve ben bu cevabı yazana kadar belge bile eklemiş.

ERMAN SAYINALP · 19 Ekim 2015

Sevgili Özdemir,

Bu gün kendimi çok şanslı hissediyorum, emeğinize aklınıza sağlık, müteşekkirim, varolun.
Saygılarımla.

ERMAN SAYINALP · 19 Ekim 2015

Sevgili Baran,

Size de çok teşekkürler, ben İş Bankası Emekli Grup Müdürüyüm. Sorduğunuz için arz ettim.

halit3 · 19 Ekim 2015

Bu kod biraz daha hızlı

Kod:

Sub arama5()

ZBasla = TimeValue(Now)
zaman = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual


Sayfa = "EKSİK FATURALAR"
sat = 3

ReDim ara1(65000): ReDim ara2(65000):

son1 = Worksheets(Sayfa).Cells(Rows.Count, "e").End(3).Row

For k = 3 To son1
aranan1 = Worksheets(Sayfa).Cells(k, "e").Value
aranan2 = Worksheets(Sayfa).Cells(k, "f").Value

For j = aranan1 To aranan2
say1 = say1 + 1
ara1(say1) = j
Next j
Next k



For i = 1 To ActiveWorkbook.Sheets.Count
If Sheets(i).Name <> Sayfa Then
son = Worksheets(Sheets(i).Name).Cells(Rows.Count, "A").End(3).Row

For r = 1 To son
say2 = say2 + 1
ara2(say2) = Worksheets(Sheets(i).Name).Cells(r, 1).Value

Next r
End If
Next i



sat1 = 3

For r = 1 To say1
aranan1 = ara1(r)

say3 = 0
For i = 1 To say2
If ara2(i) = aranan1 Then

say3 = 1
Exit For
End If
Next i
If say3 = 0 Then
Worksheets(Sayfa).Cells(sat1, "d").Value = aranan1
sat1 = sat1 + 1
End If

Next r

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
zBitis = TimeValue(Now)

MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla), vbInformation, " Sonuç Penceresi"

End Sub

Fatura Sıra No Takip Makrosu

ERMAN SAYINALP

Ömer BARAN

Uzman

ERMAN SAYINALP

Ekli dosyalar

Ömer BARAN

Uzman

ERMAN SAYINALP

halit3

Uzman

halit3

Uzman

halit3

Uzman

halit3

Uzman

ERMAN SAYINALP

Ekli dosyalar

Ömer BARAN

Uzman

ERMAN SAYINALP

Ekli dosyalar

Ömer BARAN

Uzman

Ekli dosyalar

ERMAN SAYINALP

halit3

Uzman

Ekli dosyalar

Ömer BARAN

Uzman

ERMAN SAYINALP

ERMAN SAYINALP

halit3

Uzman