BELGE TÜRÜNE GÖRE FORM-BA -BS

[ozanyakar]

Merhaba Üstadlarım.
Ekli tabloda firma isimleri ve bu firmaların belge türleri var. Kuracağımız formülnde şunu bekliyoruz :

A-) Firmanın tutar sütunundaki toplamı (E-Belge + Kağıt Belge olarak) 5000 den büyük ve eşitse, ve ilgili SATIR daki belge türü kağıt belge ise formülün bulunduğu SATIRA satırdaki ilgili firmanın tutarı getirilmeli. ( Herhangi boş bir sütuna formül yazılabilir)

B-) Firmanın tutar sütunundaki toplamı (E-Belge + Kağıt Belge olarak) 5000 den büyük ve eşitse, ve ilgili SATIR daki belge türü ELEKTRONİK BELGE ise formülün bulunduğu SATIRA satırdaki ilgili firmanın tutarı BOŞ " " getirilmeli. ( Herhangi boş bir sütuna formül yazılabilir)

C-) Firmanın tutar sütunundaki toplamı (E-Belge + Kağıt Belge olarak) 5000 den küçükse boş getirilmeli " "

Denedim ama beceremedim. Yardımcınızı rica ederim. Mümkün ise formül ile yapılmasını talep ve rica ediyorum.

 

[ozanyakar]

Yani özetler, Maliye Bakanlığı şunu diyor: " Aynı firmadan hem e-belge, hem kağıt belgeolarak alışveriş yapmış olabilirsin. Firmanın bu 2 belge türündeki tutarı ay içinde 5.000 ve üzeri ise bana sadece kağıt belgeyi bildir. E-Belge zaten bende var onu bildirme " diyor.

 

[veyselemre]

Çalışma sayfasındaki faturalarınızı Rapor sayfasına raporlar.

Sub test()
    Dim veri, lst, i&, ii%, say&, sira&
    With Sheets("Çalışma")
        veri = .Range("A2:C" & .Cells(Rows.Count, 1).End(3).Row).Value
    End With
    ReDim lst(1 To UBound(veri), 1 To 5)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(veri)
            If Not .exists(veri(i, 1)) Then
                say = say + 1
                lst(say, 1) = veri(i, 1)
                .Item(veri(i, 1)) = say
            End If
            sira = .Item(veri(i, 1))
            lst(sira, 2) = lst(sira, 2) + veri(i, 3)
            If Len(veri(i, 2)) = 16 Then
                lst(sira, 3) = lst(sira, 3) + veri(i, 3)
            Else
                lst(sira, 4) = lst(sira, 4) + veri(i, 3)
                lst(sira, 5) = lst(sira, 5) + 1
            End If
        Next i
    End With
    With Sheets("Rapor")
        .Cells.Clear
        With .Cells(1, 1).Resize(, 6)
            .Value = Array("FİRMA", "TOPLAM", "EFATURA TOPLAM", "KAĞIT F.TOPLAM", "KAĞIT F.ADET", "BİLDİRİM")
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
            .Interior.Color = rgbMidnightBlue
            .Font.Color = rgbMintCream
        End With
        For i = 1 To UBound(lst)
            For ii = 1 To 5
                .Cells(i + 1, ii) = lst(i, ii)
            Next ii
            If lst(i, 2) > 5000 And lst(i, 4) > 0 Then
                .Cells(i + 1, 6) = "Bildirim Yapılacak"
                .Cells(i + 1, 1).Resize(, 6).Interior.Color = rgbAqua
            End If
        Next i
    End With
End Sub

 

[ozanyakar]

Sayın veyselemre elinize sağlık. Çok teşekkür ederim. Sorunsuz çalışıyor.

 

[ozanyakar]

Sayın [B]veyselemre[/B] müsait olduğunuzda aynı çalışmayı yüklediğim dosya içinde yapabilir miyiz ?.
Önceki çalışmayı formül ile yapılır bende ordan uyarlarım diye düşünüp örnek olarak attım ama makro bilgim hiç yok maalesef. O Yüzden yeni dosyaya uyarlayamadım. Kusura bakmayın.

Bu yeni dosyayı biz her ay muhasebe proğramından fatura raporundan alıyoruz. Sonraki çalışmalarda da veriler hep aynı sütunda olur.

V Sütunundaki çalışmayı ben hazırladım. Hazırlanacak kod buradaki belge türüne bakmalı. ( E-Belge, Kağıt Belge)
Önceki dosyadan farkı ise : toplatacağımız rakam :
Fatura toplamı (H Sütunu) - Toplam İndirim ( I Sütunu)+ Toplam Masraf (J Sütunu)
Örneğin 100 TL - 25 TL + 10 TL = 85 TL yi biz dikkate almalıyız.

 

[veyselemre]

Sub test()
    Dim veri, lst, i&, ii%, say&, sira&, firma$, tutar As Double
    With Sheets("Ftr.Dökümü")
        veri = .Range("B3:J" & .Cells(Rows.Count, 2).End(3).Row).Value
    End With
    ReDim lst(1 To UBound(veri), 1 To 5)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(veri)
            firma = veri(i, 5)
            tutar = veri(i, 7) - veri(i, 8) + veri(i, 9)
            If Not .exists(firma) Then
                say = say + 1
                lst(say, 1) = firma
                .Item(firma) = say
            End If
            sira = .Item(firma)
            lst(sira, 2) = lst(sira, 2) + tutar
            If Len(veri(i, 1)) = 16 Then
                lst(sira, 3) = lst(sira, 3) + tutar
            Else
                lst(sira, 4) = lst(sira, 4) + tutar
                lst(sira, 5) = lst(sira, 5) + 1
            End If
        Next i
    End With
    With Sheets("Rapor")
        .Cells.Clear
        With .Cells(1, 1).Resize(, 6)
            .Value = Array("FİRMA", "TOPLAM", "EFATURA TOPLAM", "KAĞIT F.TOPLAM", "KAĞIT F.ADET", "BİLDİRİM")
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
            .Interior.Color = rgbMidnightBlue
            .Font.Color = rgbMintCream
            .Offset(1, 1).Resize(say, 3).NumberFormat = "#,##0.00"
        End With
        For i = 1 To say
            For ii = 1 To 5
                .Cells(i + 1, ii) = lst(i, ii)
            Next ii
            If lst(i, 2) > 5000 And lst(i, 4) > 0 Then
                .Cells(i + 1, 6) = "Bildirim Yapılacak"
                .Cells(i + 1, 1).Resize(, 6).Interior.Color = rgbAqua
            End If
        Next i
        .Columns.AutoFit
    End With
End Sub

 

[ozanyakar]

Sayın veyselemre ,elinize emeğinize sağlık. Hiçbir sıkıntı yok, sorunsuz çalışıyor. Çok teşekkür ederim. Sağ olun,var olun.