Filtre Sorunu

[stier_22]

Merhaba arkadaşlar,

Elimde 410.760 satırlık bir liste var ve bunun içerisinde mükerrer fatura var aslında mükerrer değil parçalara ayrılmış ben aynı numarayı tekrar eden belgeleri birleştirmek istiyorum. Koşullu biçimlendirme yapıyorum liste satır sayı çok uzun olduğu için kastırıp kitliyor hiçbir işlem yapamıyorum acaba bunun başka bir çözüm yolu var mıdır?

Çok rica ediyorum kafayı yiycem yoksa

 

[Muzaffer Ali]

Merhaba.

Örnek bir dosya ekleyin. Bu örnek dosya içinde parçalara ayrılmış ve ayrılmamış bir kaç fatura olsun.
Nasıl bir sonuç istediğinizi de belirtin.

 

[stier_22]

EKtedir.

İstediğim tekrar eden fatura numaralarını bir kalemde gelmesi. Gelirkende mal cinsi kısmı ile beraber yani hem ayakkabı hem tekstil varsa ikisi yan yana yazsın adetleri toplayıp yazsın fatura matrah ve kdv yi toplayıp yazsın her birinden 1 fatura olsun.

Ayrıca e-fatura sütununda da tekrar eden belge var bunları da aynı mantıkla tek bir fatura olarak yapsın istiyorum. Mümkün müdür acaba?

 

[BAYRAM SARI]

Pivot tablo ile hızlı ve detaylı yapılabilir????

 

[stier_22]

.

 

[stier_22]

Merhaba.

Örnek bir dosya ekleyin. Bu örnek dosya içinde parçalara ayrılmış ve ayrılmamış bir kaç fatura olsun.
Nasıl bir sonuç istediğinizi de belirtin.

Hocam bakabildiniz mi acaba??

 

[tugkan]

Pivot tablo ile hızlı ve detaylı yapılabilir????

Merhaba,
Sayın @BAYRAM SARI 'nın dediği gibi pivot table ile çok kolay yapılabilir. Ben Pivot table yapılmış şekilde dosyayı ekliyorum. Bu konuyu biraz araştırın istediğiniz şekilde özelleştirebilirsiniz.

 

[Korhan Ayhan]

Eklediğiniz dosyaya birde görmek istediğiniz sonucu da eklerseniz özet tablo dışında makrolu alternatiflerde sunulabilir.

 

[stier_22]

Eklediğiniz dosyaya birde görmek istediğiniz sonucu da eklerseniz özet tablo dışında makrolu alternatiflerde sunulabilir.

Merhaba üstad,
Dosyanın tamamı aşağıdaki linkte yer almaktadır.
Var olan ve olmasını istediğim yan yana sayfalarda
1.sayfada olan aynı fatura no.sunu tekrar eden belgeleri 2. sayfada birleştirmek istiyorum.
Birleştirirkende tek fatura halinde farklı mal cinslerini alıp yan yana yazmasını adetleri toplamasını matrahı ve KDV'yi toplayıp tek fatura haline gelmesini istiyorum. Özet tabloda bu kısmen mümkün olmuyor makro işimi görebilir. İlgilenecek üstadlara şimdiden çok teşekkür ederim.

https://we.tl/t-p4gA2NrJ92

 

[Ziynettin]

Dosyanızı İndir

Sub Benzersiz_Topla()
Z = TimeValue(Now)
Application.ScreenUpdating = False
Set S1 = Sheets("VAR OLAN LİSTE")
Set S2 = Sheets("OLMASINI İSTEDİĞİM LİSTE")
a = S1.Range("C2:L" & S1.Cells(Rows.Count, 3).End(3).Row).Value
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
ReDim b(1 To UBound(a), 1 To UBound(a, 2))
    For i = 1 To UBound(a)
        krt = a(i, 3) & a(i, 6)
        If Not d.exists(krt) Then
            d(krt) = krt
            deg = a(i, 3) & a(i, 4)
                If Not d1.exists(deg) Then
                    d1(deg) = d1.Count + 1
                    say = d1.Count
                    For y = 1 To 5
                        b(say, y) = a(i, y)
                    Next y
                    b(say, 9) = a(i, 9)
                End If
            sat = d1(deg)
            b(sat, 6) = b(sat, 6) & a(i, 6) & ", "
        End If
        sat = 0
        sat = d1(deg)
        b(sat, 7) = b(sat, 7) + CDbl(a(i, 7))
        b(sat, 8) = b(sat, 8) + a(i, 8)
        b(sat, 10) = b(sat, 10) + a(i, 10)
    Next i

S2.[C2].Resize(d1.Count, UBound(a, 2)) = b
S2.Select
Application.ScreenUpdating = True
MsgBox "işlem bitti." & vbLf & CDate(TimeValue(Now) - Z), vbInformation
End Sub

 

[stier_22]

Dosyanızı İndir

Sub Benzersiz_Topla()
Z = TimeValue(Now)
Application.ScreenUpdating = False
Set S1 = Sheets("VAR OLAN LİSTE")
Set S2 = Sheets("OLMASINI İSTEDİĞİM LİSTE")
a = S1.Range("C2:L" & S1.Cells(Rows.Count, 3).End(3).Row).Value
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
ReDim b(1 To UBound(a), 1 To UBound(a, 2))
    For i = 1 To UBound(a)
        krt = a(i, 3) & a(i, 6)
        If Not d.exists(krt) Then
            d(krt) = krt
            deg = a(i, 3) & a(i, 4)
                If Not d1.exists(deg) Then
                    d1(deg) = d1.Count + 1
                    say = d1.Count
                    For y = 1 To 5
                        b(say, y) = a(i, y)
                    Next y
                End If
            sat = d1(deg)
            b(sat, 6) = b(sat, 6) & a(i, 6) & ", "
        End If
        sat = 0
        sat = d1(deg)
        b(sat, 7) = b(sat, 7) + CDbl(a(i, 7))
        b(sat, 8) = b(sat, 8) + a(i, 8)
        b(sat, 10) = b(sat, 10) + a(i, 10)
    Next i

S2.[C2].Resize(d1.Count, UBound(a, 2)) = b
S2.Select
Application.ScreenUpdating = True
MsgBox "işlem bitti." & vbLf & CDate(TimeValue(Now) - Z), vbInformation
End Sub

Elinize,emeğinize sağlık üstad, nasıl mutluyum anlatamam harika bir iş çıkarmışsınız

 

[Ziynettin]

Kdv oranı gözden kaçmış. Koda b(say, 9) = a(i, 9) satırı eklendi.

 

[Korhan Ayhan]

Merhaba Ziynettin Bey,

Yazdığınız kod KDV oran ayrımına bakmıyor sanırım.

Denediğimde aynı fatura numarası için ilk gördüğü KDV oranını yazıyor.

 

[stier_22]

Kdv oranı gözden kaçmış. Koda b(say, 9) = a(i, 9) satırı eklendi.

KDV oranı önemli değil tek KDV var onu hallederim fakat şöyle bir şey olmuş vergi numarası 0 ile başlayanların başından 0'lar gitmiş dolayısıyla vergi noları 9 ya da 00 larda 8 haneye düşmüş bunun pratik bir yöntemi var mıdır acaba?

 

[Ziynettin]

Merhaba Ziynettin Bey,

Yazdığınız kod KDV oran ayrımına bakmıyor sanırım.

Denediğimde aynı fatura numarası için ilk gördüğü KDV oranını yazıyor.

Merhaba Korhan Bey,

KDV oran ayrımı için b(sat, 9) = b(sat, 9) & a(i, 9) & ", " satırı eklendi.

Sub Benzersiz_Topla()
Z = TimeValue(Now)
Application.ScreenUpdating = False
Set S1 = Sheets("VAR OLAN LİSTE")
Set S2 = Sheets("OLMASINI İSTEDİĞİM LİSTE")
a = S1.Range("C2:L" & S1.Cells(Rows.Count, 3).End(3).Row).Value
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
ReDim b(1 To UBound(a), 1 To UBound(a, 2))
    For i = 1 To UBound(a)
        krt = a(i, 3) & a(i, 6)
        If Not d.exists(krt) Then
            d(krt) = krt
            deg = a(i, 3) & a(i, 4)
                If Not d1.exists(deg) Then
                    d1(deg) = d1.Count + 1
                    say = d1.Count
                    For y = 1 To 5
                        b(say, y) = a(i, y)
                    Next y
                End If
            sat = d1(deg)
            b(sat, 6) = b(sat, 6) & a(i, 6) & ", "
            b(sat, 9) = b(sat, 9) & a(i, 9) & ", "
        End If
        sat = 0
        sat = d1(deg)
        b(sat, 7) = b(sat, 7) + CDbl(a(i, 7))
        b(sat, 8) = b(sat, 8) + a(i, 8)
        b(sat, 10) = b(sat, 10) + a(i, 10)
    Next i
S2.[G2].Resize(d1.Count).NumberFormat = "@"
S2.[C2].Resize(d1.Count, UBound(a, 2)) = b
S2.Select
Application.ScreenUpdating = True
MsgBox "işlem bitti." & vbLf & CDate(TimeValue(Now) - Z), vbInformation
End Sub

 

[Ziynettin]

KDV oranı önemli değil tek KDV var onu hallederim fakat şöyle bir şey olmuş vergi numarası 0 ile başlayanların başından 0'lar gitmiş dolayısıyla vergi noları 9 ya da 00 larda 8 haneye düşmüş bunun pratik bir yöntemi var mıdır acaba?

#15. mesajdaki kodu tekrar deneyiniz.

 

[1903emre34@gmail.com]

Merhaba,

Birleştirirken tek fatura halinde farklı mal cinslerini alıp yan yana yazmasını adetleri toplamasını matrahı ve KDV'yi toplayıp tek fatura haline yanında M ve N sütun eklersek hesapa dahil etmesi için kodlara nasıl ek ilave yaparız (M sütunda örnek olarak 201002)

 

[Ziynettin]

Merhaba Emre bey,

Ne yapmak istediğinizi anlayamadım. Sorunuzu örnek dosya üzerinden olması gereken sonuçlarla ekleyebilir misiniz.

 

[1903emre34@gmail.com]

Merhaba,

Dosya ekte gibidir, istenilen sayfa2'de yapılmıştır

 

[Ziynettin]

Merhaba,

#19 iletiyi yeni gördüm.

Sub test_1()
Dim s1 As Worksheet, s2  As Worksheet, krt, krt1
Dim a(), b(), d As Object, d1 As Object
Dim i As Long, j As Byte, say As Long, sat As Long
Set s1 = Sheets("SAYFA 1")
Set s2 = Sheets("SAYFA 2")
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")

a = s1.Range("C5:Q" & s1.Cells(Rows.Count, 3).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To UBound(a, 2))

    For i = 1 To UBound(a)
        krt = a(i, 3) & a(i, 14)
        If Not d.exists(krt) Then
            d(krt) = ""
            krt1 = a(i, 3)
            If Not d1.exists(krt1) Then
                d1(krt1) = d1.Count + 1
                say = d1.Count
                For j = 1 To 6: b(say, j) = a(i, j): Next j
                For j = 11 To 13: b(say, j) = a(i, j): Next j
                b(say, 14) = a(i, 14)
                b(say, 15) = a(i, 15)
             Else
                sat = 0
                sat = d1(krt1)
                b(sat, 14) = b(sat, 14) & ", " & a(i, 14)
            End If
        End If
        sat = 0
        sat = d1(krt1)
        For j = 7 To 10: b(sat, j) = b(sat, j) + CDbl(a(i, j)): Next j
    Next i
    s2.Range("C5:Q" & Rows.Count).ClearContents
    If say > 0 Then
        s2.[C5].Resize(say, UBound(a, 2)) = b
    End If
MsgBox "İşlem tamam.", vbInformation
End Sub