Aynı fatura numaralı satırlardaki verileri toplama

[ilkervarol]

Kolay gelsin excel üstadları. Aşağıda bulunan excel dosyasında aynı fatura numaralı satırlar mevcut, bu satırlardaki J ve K sütunlarını toplayarak tek satır haline getirmek istiyoruz. Yani mükerrer faturaları birleştirip matrah ve kdv lerini toplamak istiyoruz.

Yardımlarınız için şimdiden çok teşekkürler, iyi çalışmalar.

İndir kdv Iade Indirilecek Kdv Listesi

Dosyayı indir kdv Iade Indirilecek Kdv Listesi

dosya.co

 

[işsiz123]

Merhabalar
ETOPLA() foksiyonu işinize yarayabilir.

 

[aspava]

denermisiniz.

İndir kdv Iade Indirilecek Kdv Listesi

Dosyayı indir kdv Iade Indirilecek Kdv Listesi

dosya.co

 

[ilkervarol]

denermisiniz.

İndir kdv Iade Indirilecek Kdv Listesi

Dosyayı indir kdv Iade Indirilecek Kdv Listesi

dosya.co

Ellerinize sağlık bu şekilde bir toplama istiyorum fakat aşağıdaki gibi bir makro ile direkt ilgili satırları değiştirmesini sağlayabilir miyiz acaba?

Sub test()
Dim a, i As Long, ii As Long
With Sheets("Yüklenilen KDV Listesi").Cells(1).CurrentRegion
a = .Value
With .Offset(1)
.ClearContents
.Borders.LineStyle = xlNone
End With
With CreateObject("Scripting.Dictionary")
For i = 2 To UBound(a, 1)
If Not .exists(a(i, 4)) Then
.Item(a(i, 4)) = .Count + 1
For ii = 1 To UBound(a, 2)
a(.Item(a(i, 4)), ii) = a(i, ii)
Next
Else
a(.Item(a(i, 4)), 11) = a(.Item(a(i, 4)), 11) + a(i, 11)
End If
Next
i = .Count
End With
With .Rows(2).Resize(i)
.Value = a
.Borders.Weight = 2
End With
End With
End Sub

 

[ilkervarol]

Yukarıda yolladığım makro daha önce paylaşılmış ama başka bir dosya için. Bunu attığım dosyaya uyarlama şansımız var mıdır? Ama bu makroda sadece kdv tutarları birleştirilmiş, ben matrahında birleşmesini istiyorum.

 

[aspava]

açıkçası makro bilgim yeterli değil , Forumda sizlere yardımcı olacak üstatlarımız olacaktır.

 

[ilkervarol]

açıkçası makro bilgim yeterli değil , Forumda sizlere yardımcı olacak üstatlarımız olacaktır.

Teşekkür ediyorum, iyi geceler.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Faturaları_Birlestir()
    Dim Veri As Variant, Son As Long, X As Long, Say As Long
    Dim Y As Byte, S1 As Worksheet, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("İndirilecek KDV Listesi")

    Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
   
    If Son <= 5 Then Son = 6

    Veri = S1.Range("B5:N" & Son).Value
   
    ReDim Liste(1 To Son, 1 To 13)
    
    With CreateObject("Scripting.Dictionary")
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            If Not .Exists(Veri(X, 4)) Then
                Say = Say + 1
                .Add Veri(X, 4), Say
                Liste(Say, 1) = Say
                For Y = 2 To 13
                    Liste(Say, Y) = Veri(X, Y)
                Next
            Else
                Liste(.Item(Veri(X, 4)), 9) = Liste(.Item(Veri(X, 4)), 9) + Veri(X, 9)
                Liste(.Item(Veri(X, 4)), 10) = Liste(.Item(Veri(X, 4)), 10) + Veri(X, 10)
            End If
        Next

        If .Count > 0 Then
            S1.Range("B5:N" & S1.Rows.Count).ClearContents
            S1.Range("E5").Resize(.Count, 1).NumberFormat = "@"
            S1.Range("G5").Resize(.Count, 1).NumberFormat = "@"
            S1.Range("M5").Resize(.Count, 1).NumberFormat = "@"
            S1.Range("B5").Resize(.Count, 13) = Liste
            MsgBox "Faturaların birleştirme işlemi tamamlanmıştır." & vbLf & vbLf & _
                   "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
        Else
            MsgBox "Birleştirme için uygun veri bulunamadı!", vbExclamation
        End If
    End With

    Set S1 = Nothing
End Sub

 

[Tevfik_Kursun]

Merhaba Arkadaşlar,
Ellerinize sağlık. Sanırım bir de benzer kontrolü yapmak lazım!
Saygılarımla

 

[ilkervarol]

Deneyiniz.

Option Explicit

Sub Faturaları_Birlestir()
    Dim Veri As Variant, Son As Long, X As Long, Say As Long
    Dim Y As Byte, S1 As Worksheet, Zaman As Double
   
    Zaman = Timer
   
    Set S1 = Sheets("İndirilecek KDV Listesi")

    Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
  
    If Son <= 5 Then Son = 6

    Veri = S1.Range("B5:N" & Son).Value
  
    ReDim Liste(1 To Son, 1 To 13)
   
    With CreateObject("Scripting.Dictionary")
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            If Not .Exists(Veri(X, 4)) Then
                Say = Say + 1
                .Add Veri(X, 4), Say
                Liste(Say, 1) = Say
                For Y = 2 To 13
                    Liste(Say, Y) = Veri(X, Y)
                Next
            Else
                Liste(.Item(Veri(X, 4)), 9) = Liste(.Item(Veri(X, 4)), 9) + Veri(X, 9)
                Liste(.Item(Veri(X, 4)), 10) = Liste(.Item(Veri(X, 4)), 10) + Veri(X, 10)
            End If
        Next

        If .Count > 0 Then
            S1.Range("B5:N" & S1.Rows.Count).ClearContents
            S1.Range("E5").Resize(.Count, 1).NumberFormat = "@"
            S1.Range("G5").Resize(.Count, 1).NumberFormat = "@"
            S1.Range("M5").Resize(.Count, 1).NumberFormat = "@"
            S1.Range("B5").Resize(.Count, 13) = Liste
            MsgBox "Faturaların birleştirme işlemi tamamlanmıştır." & vbLf & vbLf & _
                   "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
        Else
            MsgBox "Birleştirme için uygun veri bulunamadı!", vbExclamation
        End If
    End With

    Set S1 = Nothing
End Sub

Elleriniz dert görmesin valla tam istediğim gibi. Çok teşekkürler.

 

[ilkervarol]

Merhaba Arkadaşlar,
Ellerinize sağlık. Sanırım bir de benzer kontrolü yapmak lazım!
Saygılarımla

Nasıl yani üstadım?

 

[Tevfik_Kursun]

Merhaba,
488 sayısı 2 defa tekrarlanmış
İyi çalışmalar

 

[ilkervarol]

Merhaba,
488 sayısı 2 defa tekrarlanmış
İyi çalışmalar

Valla üstadım tam anlamadım bir yerde hata varsa benim için önemli.Tam olarak nedir dediğiniz?

 

[Tevfik_Kursun]

Kusura bakmayın lütfen, başka bir konu ile ilgilenirken sonucu bu maddede 9. mesaj olarak yazmışım. Tekrar özür dilerim.
Saygılarımla