Fatura listesinde aynı cari kod olan değerleri toplama

bkaskaya · 2 Kasım 2018

Ü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

Korhan Ayhan · 2 Kasım 2018

Merhaba,

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

1903emre34@gmail.com · 2 Kasım 2018

Dosya ektedir.

http://www.dosya.tc/server15/k1xe4a/Fatura_Liste_excel.zip.html

Ömer BARAN · 2 Kasım 2018

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

bkaskaya · 2 Kasım 2018

Korhan Ayhan' Alıntı:
Merhaba,

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

Üstadım denedim bir kaç şekilde ama yapamadım bir türlü. tabi bunda benim excel bilgimin az olması da etkendir.

bkaskaya · 2 Kasım 2018

1903emre34@gmail.com' Alıntı:
Dosya ektedir.

http://www.dosya.tc/server15/k1xe4a/Fatura_Liste_excel.zip.html

Üstadım yardımın için çok teşekkür ederim. Ben herhalde tam olarak anlatamadım o yüzden eksik kaldı. Sağolsun Ömer Baran bey in cevabı işimi gördü. Elinize emeğinize sağlık.

bkaskaya · 2 Kasım 2018

Ö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

Ö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.

Ömer BARAN · 2 Kasım 2018

Eyvallah, kolay gelsin.

halit3 · 2 Kasım 2018

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

bkaskaya · 3 Kasım 2018

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

Teşekkürler Halit bey elinize sağlık.

bkaskaya · 3 Kasım 2018

Ömer BARAN' Alıntı:
Eyvallah, kolay gelsin.

Ö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.

Ömer BARAN · 3 Kasım 2018

İ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.
.

halit3 · 3 Kasım 2018

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

Ömer BARAN · 3 Kasım 2018

.
Önceki kod cevabım güncellendi.
Sayfayı yenileyerek kontrol ediniz.
.

bkaskaya · 5 Kasım 2018

Ömer BARAN' Alıntı:
.
Önceki kod cevabım güncellendi.
Sayfayı yenileyerek kontrol ediniz.
.

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

Tekrar teşekkürler halit bey. iyi çalışmalar.

bkaskaya · 5 Kasım 2018

Ömer BARAN' Alıntı:
.
Önceki kod cevabım güncellendi.
Sayfayı yenileyerek kontrol ediniz.
.

Ömer bey çok teşekkür ederim.iyi günler dilerim.

Fatura listesinde aynı cari kod olan değerleri toplama

bkaskaya

Korhan Ayhan

Administrator

1903emre34@gmail.com

Ömer BARAN

Uzman

bkaskaya

bkaskaya

bkaskaya

Ömer BARAN

Uzman

halit3

Uzman

bkaskaya

bkaskaya

Ömer BARAN

Uzman

halit3

Uzman

Ömer BARAN

Uzman

bkaskaya

bkaskaya