Eksik makbuz takibi

[a.c.uysak]

HERKESE KOLAY GELSİN,

ARKADAŞLAR YARDIMINIZA İHTİYACIM VAR.

Muhasebeye teslim edilmeyen makbuzları takip etmek istiyorum.

* HER PAZARLAMACIYA AİT BİR MAKBUZ KOÇANI VAR. BU KOÇANIN HER SAYFASININ SERİ NUMARASI VAR.

"makbuz no.-pazarlamacı" isimli sayfamda her bir pazarlamacıya verilmiş koçanın ilk ve son sayfa seri numaralarını yazdım sadece başlangıç ve bitiş olarak.

"verilen makbuz no.-tutar" isimli sayfamda seri numarası ve tutarı verilmiş muhasebeye teslim edilen makbuzlar bulunmakta.

"eksik makbuz no.-pazarlamacı" isimli sayfamda ise yazılmasını istediğim değer şunlar;

"verilen makbuz no.-tutar" sayfası kontrol edilerek hangi seri no lu makbuz teslim edilmemişse onu bu sayfada görmek istiyorum ve yanına da hangi pazarlamacıya ait olduğunu görmek istiyorum.

umarım anlatabilmişimdir,

yardımcı olursanız sevinirim.

 

[Necdet]

Merhaba,

Makro ile çözümü aşağıdadır. Dosyayı inceleyiniz.

Sub Eksik_Makbuz_No_Bul()
 
    Dim i   As Long, _
        Son As Long, _
        Bas As Long, _
        Bit As Long, _
        Adt As Integer, _
        j   As Integer, _
        sm  As Worksheet, _
        sv  As Worksheet, _
        se  As Worksheet, _
        c   As Range
        
    Application.ScreenUpdating = False
    
    Set sm = Sheets("makbuz no.- pazarlamacı")
    Set sv = Sheets("verilen makbuz no.-tutar")
    Set se = Sheets("eksik makbuz no.- pazarlamacı")
    j = 1
    
    Son = se.Cells(Rows.Count, "A").End(3).Row
    If Son > 1 Then se.Range("A2:B" & Son).ClearContents
    
    Son = sm.Cells(Rows.Count, "A").End(3).Row
    Bas = Application.WorksheetFunction.Min(sm.Range("A2:B" & Son))
    Bit = Application.WorksheetFunction.Max(sm.Range("A2:B" & Son))
     
    For i = Bas To Bit
        
        Set c = sv.Range("A:A").Find(i, LookIn:=xlValues, LookAt:=xlWhole)
        If c Is Nothing Then
            Adt = Adt + 1
            j = j + 1
            se.Cells(j, "A") = i
            se.Cells(j, "B") = Application.WorksheetFunction.Lookup(i, sm.Range("A2:A" & Son), sm.Range("C2:C" & Son))
        End If
            
    Next i
    
    se.Select
    If Adt = 0 Then
        MsgBox "HİÇ EKSİK MAKBUZ BULUNMADI", vbInformation, "Necdet YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    Else
        MsgBox Adt & " ADET EKSİK MAKBUZ BULUNDU VE LİSTELENDİ...", vbCritical, "Necdet YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    End If
    
End Sub

 

[Necdet]

Koçanlar bitmiş herhalde

 

[a.c.uysak]

Çok affedersiniz Nejdet Bey,

Yıl sonu olduğu için haliyle bayağı bir yoğunduk ancak inceleyebilme fırsatım oldu.

Koçanlar biter mi hiç daha yeni başlıyoruz kollarımızı sıvadık sizi bekliyorduk

Size teşekkürü bir borç bilirim. Emeğinize sağlık. Tahmin edemeyeceğiniz kadar işime yarayacak.


Belki saçma bir soru olabilir ama her ne kadar kodu incelesem de makroyu çok anlamadığım için soruyorum;
Pazarlamacı sayısı artsa sütun başlıkları hariç tüm verileri silip yeni veriler girsem, liste uzasa da kısalsa da sıkıntı olmaz değil mi?

 

[Necdet]

Merhaba,

Deneyiniz ve görünüz