yinelenenler miktarı topla ve tek koda düşürme

sevensuleyman

Altın Üye
Katılım
9 Kasım 2012
Mesajlar
175
Excel Vers. ve Dili
office 2010
Altın Üyelik Bitiş Tarihi
08-12-2027
merhaba ;

50.000 satırlı excell dosyam var . örnekte paylaştıgım gibi mükerrer olan olan kodlar mevcut kiminde miktar sıfır kiminle miktarlar var. burada yapmak istediğimiz stok kodları aynı ise miktarı topla ve kodlasrı teke düşür. ayrı saya olmasına gerek yok. aynı sayfada yapmak istiyorum . makro yazabilirseniz. çok sevinirim. üstadlardan destek bekliyorum
 

Ekli dosyalar

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,056
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Aşağıdaki kodu deneyin.

Not: Denemeden önce dosyanızın bir yedeğini alın.

Kod:
Sub yinelenenlerikaldir()

sonsat = Cells(Rows.Count, "B").End(3).Row

For a = 2 To sonsat

say = WorksheetFunction.CountIf(Range("B:B"), Cells(a, "B"))
If say > 0 Then Cells(a, "C") = WorksheetFunction.SumIf(Range("B:B"), Cells(a, "B"), Range("C:C"))

Next

ActiveSheet.Range("A2:C" & sonsat).RemoveDuplicates Columns:=2, Header:=xlNo

End Sub
 

sevensuleyman

Altın Üye
Katılım
9 Kasım 2012
Mesajlar
175
Excel Vers. ve Dili
office 2010
Altın Üyelik Bitiş Tarihi
08-12-2027
Aşağıdaki kodu deneyin.

Not: Denemeden önce dosyanızın bir yedeğini alın.

Kod:
Sub yinelenenlerikaldir()

sonsat = Cells(Rows.Count, "B").End(3).Row

For a = 2 To sonsat

say = WorksheetFunction.CountIf(Range("B:B"), Cells(a, "B"))
If say > 0 Then Cells(a, "C") = WorksheetFunction.SumIf(Range("B:B"), Cells(a, "B"), Range("C:C"))

Next

ActiveSheet.Range("A2:C" & sonsat).RemoveDuplicates Columns:=2, Header:=xlNo

End Sub
çok teşekkür ederim tam istediğim gibi
 
Üst