• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Filtre Sorunu

S

stier_22

Altın Üye
Katılım
15 Eylül 2009
Mesajlar
147
Excel Vers. ve Dili
excel 2016
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 :(
 
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.
 
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?
 

Ekli dosyalar

BAYRAM SARI' Alıntı:
Pivot tablo ile hızlı ve detaylı yapılabilir????
Genişletmek için tıkla ...

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.
 

Ekli dosyalar

Eklediğiniz dosyaya birde görmek istediğiniz sonucu da eklerseniz özet tablo dışında makrolu alternatiflerde sunulabilir.
 
Korhan Ayhan' Alıntı:
Eklediğiniz dosyaya birde görmek istediğiniz sonucu da eklerseniz özet tablo dışında makrolu alternatiflerde sunulabilir.
Genişletmek için tıkla ...

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
 
Dosyanızı İndir

Kod: 
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
 

Ekli dosyalar

Son düzenleme:
Ziynettin' Alıntı:
Dosyanızı İndir

Kod: 
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
Genişletmek için tıkla ...


Elinize,emeğinize sağlık üstad, nasıl mutluyum anlatamam harika bir iş çıkarmışsınız :)
 
Kdv oranı gözden kaçmış. Koda b(say, 9) = a(i, 9) satırı eklendi.
 
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.
 
Ziynettin' Alıntı:
Kdv oranı gözden kaçmış. Koda b(say, 9) = a(i, 9) satırı eklendi.
Genişletmek için tıkla ...

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?
 
Korhan Ayhan' Alıntı:
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.
Genişletmek için tıkla ...

Merhaba Korhan Bey,

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

Kod: 
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
 
Son düzenleme:
stier_22' Alıntı:
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?
Genişletmek için tıkla ...

#15. mesajdaki kodu tekrar deneyiniz.
 
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)
 
Merhaba Emre bey,

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

#19 iletiyi yeni gördüm.

PHP: 
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst