• DİKKAT

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

Aynı fatura numaralı satırlardaki verileri toplama

I

ilkervarol

Katılım
6 Eylül 2010
Mesajlar
7
Excel Vers. ve Dili
2007 türkçe
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
 
Merhabalar
ETOPLA() foksiyonu işinize yarayabilir.
 
aspava' Alıntı:
denermisiniz.

İndir kdv Iade Indirilecek Kdv Listesi

Dosyayı indir kdv Iade Indirilecek Kdv Listesi
dosya.co
Genişletmek için tıkla ...
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
 
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.
 
açıkçası makro bilgim yeterli değil , Forumda sizlere yardımcı olacak üstatlarımız olacaktır.
 
Deneyiniz.

C++: 
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
 
Merhaba Arkadaşlar,
Ellerinize sağlık. Sanırım bir de benzer kontrolü yapmak lazım!
Saygılarımla
 
Korhan Ayhan' Alıntı:
Deneyiniz.

C++: 
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
Genişletmek için tıkla ...
Elleriniz dert görmesin valla tam istediğim gibi. Çok teşekkürler.
 
Merhaba,
488 sayısı 2 defa tekrarlanmış
İyi çalışmalar
 
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst