• DİKKAT

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

Fatura listesinde aynı cari kod olan değerleri toplama

B

bkaskaya

Katılım
27 Mart 2008
Mesajlar
26
Excel Vers. ve Dili
Excel 2003 Tr
Üstadlarım iyi günler,
Ekteki dosyada yine bu sitenin çok büyük yardımıyla oluşturduğum bir liste var. bu listeyi baz alarak yine bir liste daha oluşturmam gerekti. aynı cari kodlu faturaların matrahlarını toplayarak tek satırda göstermesi. 35 bin satırlık bir listede bunu yapmak mümkün müdür?
Şimdiden teşekkürler.

https://drive.google.com/file/d/11Ft1LyRp4rH7MEzxZ7Q2S_7G3-XL2Z6l/view?usp=sharing
 
Merhaba,

Pivot Table (Özet Tablo) kullanabilirsiniz. Oldukça hızlı sonuç verir.
 
Merhaba. Alternatif olsun.

Toplamları belgenizdeki gibi verilerin altına listeletmek istiyorsanız aşağıdaki kod'u kullanabilirsiniz.
Rich (BB code): 
Sub TOPLAMLAR()
If Cells(Rows.Count, 1).End(3).Row < Cells(Rows.Count, 2).End(3).Row Then _
    Range("B" & Cells(Rows.Count, 1).End(3).Row + 1 & ":E" & Rows.Count).ClearContents
Range("I3:I" & Cells(Rows.Count, "I").End(3).Row).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Cells(Cells(Rows.Count, 1).End(3).Row + 6, 3), Unique:=True
For sat = Cells(Rows.Count, 1).End(3).Row + 7 To Cells(Rows.Count, 3).End(3).Row
    Cells(sat, 2) = Cells(WorksheetFunction.Match(Cells(sat, 3), [I:I], 0), 2)
    Cells(sat, 4) = WorksheetFunction.SumIf(Range("I4:I" & Cells(Rows.Count, 1).End(3).Row), Cells(sat, 3), _
                    Range("D4:D" & Cells(Rows.Count, 1).End(3).Row))
    Cells(sat, 5) = Cells(WorksheetFunction.Match(Cells(sat, 3), [I:I], 0), 10)
Next
    Cells(Cells(Rows.Count, 2).End(3).Row + 1, 4) = WorksheetFunction.Sum(Range("D" & _
            Cells(Rows.Count, 1).End(3).Row + 7 & ":D" & Cells(Rows.Count, 2).End(3).Row))
End Sub
 
Son düzenleme:
Ömer BARAN' Alıntı:
Merhaba. Alternatif olsun.

Toplamları belgenizdeki gibi verilerin altına listeletmek istiyorsanız aşağıdaki kod'u kullanabilirsiniz.
Rich (BB code): 
Sub TOPLAMLAR()
If Cells(Rows.Count, 1).End(3).Row < Cells(Rows.Count, 2).End(3).Row Then _
    Range("B" & Cells(Rows.Count, 1).End(3).Row + 1 & ":E" & Rows.Count).ClearContents
Range("B3:B" & Cells(Rows.Count, 1).End(3).Row).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Cells(Cells(Rows.Count, 1).End(3).Row + 6, 2), Unique:=True
For sat = Cells(Rows.Count, 1).End(3).Row + 7 To Cells(Rows.Count, 2).End(3).Row
    Cells(sat, 3) = Cells(WorksheetFunction.Match(Cells(sat, 2), [B:B], 0), 9)
    Cells(sat, 4) = WorksheetFunction.SumIf(Range("B4:B" & Cells(Rows.Count, 1).End(3).Row), Cells(sat, 2), _
                    Range("D4:D" & Cells(Rows.Count, 1).End(3).Row))
    Cells(sat, 5) = Cells(WorksheetFunction.Match(Cells(sat, 2), [B:B], 0), 10)
Next
    Cells(Cells(Rows.Count, 2).End(3).Row + 1, 4) = WorksheetFunction.Sum(Range("D" & _
            Cells(Rows.Count, 1).End(3).Row + 7 & ":D" & Cells(Rows.Count, 2).End(3).Row))
End Sub
Genişletmek için tıkla ...

Ömer bey çok teşekkürler. Allah ilminizi bilginizi arttırsın inşallah. Çok teşekkürler çok işime yarayacak. İyi akşamlar.
 
Alternatif kod
Sayfa1 deki verileri Sayfa2 ye aktarıyor.

Kod: 
Sub Gruplandir2()

ZBasla = TimeValue(Now)
zaman = Timer

Set s1 = Sheets("Sayfa1") ' veri sayfası
Set s2 = Sheets("Sayfa2") 'aktarılan sayfa

s2.Range("a1:d" & Rows.Count).ClearContents
sat1 = 1

s2.Cells(sat1, 1).Value = "Açıklama"
s2.Cells(sat1, 2).Value = "Cari Kodu"
s2.Cells(sat1, 3).Value = "Matrah"
s2.Cells(sat1, 4).Value = "VKN -TCKN"


son1 = s1.Cells(Rows.Count, "a").End(3).Row

ReDim ara1(son1): ReDim ara2(son1):

For j = 4 To son1
ara1(j) = WorksheetFunction.Trim(s1.Cells(j, "ı"))
ara2(j) = 1
Next j

sat1 = sat1 + 1

For r = 4 To son1
aranan1 = ara1(r)

sut4 = 0
If ara2(r) = 1 Then

For i = r To son1
If ara1(i) = aranan1 Then
sut4 = sut4 + CDbl(s1.Cells(i, "d").Value)
ara2(i) = 0
End If
Next i

s2.Cells(sat1, 1).Value = s1.Cells(r, "b").Value
s2.Cells(sat1, 2).Value = s1.Cells(r, "ı").Value
s2.Cells(sat1, 3).Value = sut4
s2.Cells(sat1, 4).Value = s1.Cells(r, "j").Value

sat1 = sat1 + 1

End If
Next r

s2.Cells(sat1, 3).Value = WorksheetFunction.Sum(s2.Range("C2:C" & sat1 - 1))

zBitis = TimeValue(Now)

MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla), vbInformation, " Sonuç Penceresi"

End Sub
 
Son düzenleme:
halit3' Alıntı:
Alternatif kod
Sayfa1 deki verileri Sayfa2 ye ikinci satırdan itibaren aktarıyor.

PHP: 
Sub Gruplandir()

ZBasla = TimeValue(Now)
zaman = Timer

Set s1 = Sheets("Sayfa1") ' veri sayfası
Set s2 = Sheets("Sayfa2") 'aktarılan sayfa

s2.Range("a2:d" & Rows.Count).ClearContents
son1 = s1.Cells(Rows.Count, "a").End(3).Row

ReDim ara1(son1): ReDim ara2(son1):

For j = 4 To son1
ara1(j) = WorksheetFunction.Trim(s1.Cells(j, "j"))
ara2(j) = 1
Next j

sat1 = 2

For r = 4 To son1
aranan1 = ara1(r)

sut4 = 0
If ara2(r) = 1 Then

For i = r To son1
If ara1(i) = aranan1 Then
sut4 = sut4 + CDbl(s1.Cells(i, "d").Value)
ara2(i) = 0
End If
Next i

s2.Cells(sat1, 1).Value = s1.Cells(r, "b").Value
s2.Cells(sat1, 2).Value = s1.Cells(r, "ı").Value
s2.Cells(sat1, 3).Value = sut4
s2.Cells(sat1, 4).Value = s1.Cells(r, "j").Value

sat1 = sat1 + 1

End If
Next r

s2.Cells(sat1, 3).Value = WorksheetFunction.Sum(s2.Range("C2:C" & sat1 - 1))

zBitis = TimeValue(Now)

MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla), vbInformation, " Sonuç Penceresi"

End Sub
Genişletmek için tıkla ...
Teşekkürler Halit bey elinize sağlık.
 
Ömer BARAN' Alıntı:
Eyvallah, kolay gelsin.
Genişletmek için tıkla ...
Ömer bey sizden son bir ricam olsa. Bu kodda gruplama yaparken "Açıklama" bölümünü baz alıyor sanırım. Ama bizim için önemli olan "Cari Kodu" olan bölüm. Bazen merkez-şube şeklinde veya ünvanı değişen ancak cari kodu aynı kalan firmaları gruplarken hatalı işlem oldu. Baz alınacak gruplama sütunu olarak Cari Kodu sütununu tanımlayabilirseniz çok makbule geçer.
 
İlave sorunuzu yeni fark ettim, şu an bilgisayar başından bir süre kalkmam gerekiyor,
verdiğim kod cevabını güncelleyip, durumu yeni bir mesaj ile bildiririm.
.
 
Son düzenleme:
Buradaki kodu da yeniden güncelledim
Kod: 
Sub Gruplandir()

ZBasla = TimeValue(Now)
zaman = Timer

Set s1 = Sheets("Sayfa1") ' veri sayfası
Set s2 = Sheets("Sayfa2") 'aktarılan sayfa

son1 = s1.Cells(Rows.Count, "a").End(3).Row


s1.Range("b" & son1 + 6 & ":e" & Rows.Count).ClearContents
sat1 = son1 + 6

s1.Cells(sat1, 2).Value = "Açıklama"
sat1 = sat1 + 1


ReDim ara1(son1): ReDim ara2(son1):

For j = 4 To son1
ara1(j) = WorksheetFunction.Trim(s1.Cells(j, "ı"))
ara2(j) = 1
Next j



For r = 4 To son1
aranan1 = ara1(r)

sut4 = 0
If ara2(r) = 1 Then

For i = r To son1
If ara1(i) = aranan1 Then
sut4 = sut4 + CDbl(s1.Cells(i, "d").Value)
ara2(i) = 0
End If
Next i

s1.Cells(sat1, 2).Value = s1.Cells(r, "b").Value
s1.Cells(sat1, 3).Value = s1.Cells(r, "ı").Value
s1.Cells(sat1, 4).Value = sut4
s1.Cells(sat1, 5).Value = s1.Cells(r, "j").Value

sat1 = sat1 + 1

End If
Next r

s1.Cells(sat1, 4).Value = WorksheetFunction.Sum(s1.Range("d2:d" & son1))

zBitis = TimeValue(Now)

MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla), vbInformation, " Sonuç Penceresi"

End Sub
 
Son düzenleme:
.
Önceki kod cevabım güncellendi.
Sayfayı yenileyerek kontrol ediniz.
.
 
Ömer BARAN' Alıntı:
.
Önceki kod cevabım güncellendi.
Sayfayı yenileyerek kontrol ediniz.
.
Genişletmek için tıkla ...
halit3' Alıntı:
Buradaki kodu da yeniden güncelledim
Kod: 
Sub Gruplandir()

ZBasla = TimeValue(Now)
zaman = Timer

Set s1 = Sheets("Sayfa1") ' veri sayfası
Set s2 = Sheets("Sayfa2") 'aktarılan sayfa

son1 = s1.Cells(Rows.Count, "a").End(3).Row


s1.Range("b" & son1 + 6 & ":e" & Rows.Count).ClearContents
sat1 = son1 + 6

s1.Cells(sat1, 2).Value = "Açıklama"
sat1 = sat1 + 1


ReDim ara1(son1): ReDim ara2(son1):

For j = 4 To son1
ara1(j) = WorksheetFunction.Trim(s1.Cells(j, "ı"))
ara2(j) = 1
Next j



For r = 4 To son1
aranan1 = ara1(r)

sut4 = 0
If ara2(r) = 1 Then

For i = r To son1
If ara1(i) = aranan1 Then
sut4 = sut4 + CDbl(s1.Cells(i, "d").Value)
ara2(i) = 0
End If
Next i

s1.Cells(sat1, 2).Value = s1.Cells(r, "b").Value
s1.Cells(sat1, 3).Value = s1.Cells(r, "ı").Value
s1.Cells(sat1, 4).Value = sut4
s1.Cells(sat1, 5).Value = s1.Cells(r, "j").Value

sat1 = sat1 + 1

End If
Next r

s1.Cells(sat1, 4).Value = WorksheetFunction.Sum(s1.Range("d2:d" & son1))

zBitis = TimeValue(Now)

MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla), vbInformation, " Sonuç Penceresi"

End Sub
Genişletmek için tıkla ...
Tekrar teşekkürler halit bey. iyi çalışmalar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst