8 sütunu aynı olan satırın, ilk satırda diğerlerinin toplamını alarak birleştirip mük

[hsayar]

8 sütunu aynı olan satırın, ilk satırda diğerlerinin toplamını alarak birleştirip mükerrer kayıtlarını silme

[color="red"]
2007	2006	Diğer Yıllar İçin Yapılmış Harcamalar	2006 Mali Yılı İçin	60.611,00	Dışı		Tip3A	Tip3A [/color]
2007	2008	Diğer Yıllar İçin Yapılmış Harcamalar	2008 Mali Yılı İçin	394.207,00	Dışı		Tip3A	Tip3A
2007	2009	Diğer Yıllar İçin Yapılmış Harcamalar	2009 Mali Yılı İçin	148.359,00	Dışı		Tip3A	Tip3A
2007	2010	Diğer Yıllar İçin Yapılmış Harcamalar	2010 Mali Yılı İçin	4.000,00	Dışı		Tip3A	Tip3A
[color="red"]
2007	2006	Diğer Yıllar İçin Yapılmış Harcamalar	2006 Mali Yılı İçin	10.000,00	Dışı		Tip3A	Tip3A
[/color]

[B]
[color="green"]
2007	2006	Diğer Yıllar İçin Yapılmış Harcamalar	2006 Mali Yılı İçin	70.611,00	Dışı		Tip3A	Tip3A [/color][/B]

A: D ve F:I aralığında aynı olan satırlar varsa 1. den sonraki E sütunlarındaki değerleri topla ilk bulunan satırdakine ekle

işlem saonucunda birinciş kırmız satır yeşile dönecek ve ikinci kırmızı satır silinecek mümkünmü

 

[Recep İpek]

Küçük bir örnek dosya ekleyebilirmisiniz?

 

[hsayar]

Dosya Eklenmiştir. alakanıza teşekkürler

 

[Recep İpek]

Aşağıdaki kodları deneyiniz.

Sub AktarTopla()
Dim a, b, i, n, sat, veri()
Set s1 = Sheets("TABLO")
Set s2 = Sheets("Rapor")
'*******************************************
a = s1.Range("a2:i" & s1.[a65536].End(3).Row).Value 'Veri aralığını a değişkenine ata
ReDim veri(1 To UBound(a, 1), 1 To 10) 2 Dizi limiti belirle
'*******************************************
With CreateObject("Scripting.Dictionary") ' Scripting.Dictionary Nesnesi yarat
.CompareMode = vbTextCompare
For i = 1 To UBound(a, 1)
z = a(i, 1) & ":" & a(i, 2) & ":" & a(i, 3) & ":" & a(i, 4) ' a değişkeninin 1-2-3-4 kolonlarındaki bilgiler z değişkeninde birleştir
If Not IsEmpty(z) Then 'z boş değil ise
If Not .exists(z) Then  ' ve nesne içersinde yok ise
n = n + 1
veri(n, 1) = n           'dizinin 1.elemanı sıra no
veri(n, 2) = a(i, 1)    ' dizinin 2.elemanı 1.kolon
veri(n, 3) = a(i, 2)    ' 2.kolon.
veri(n, 4) = a(i, 3)    '3.kolon
veri(n, 5) = a(i, 4)
veri(n, 7) = a(i, 6)
veri(n, 8) = a(i, 7)
veri(n, 9) = a(i, 8)
veri(n, 10) = a(i, 9)
.Add z, n 'Nesneye ekle
End If
veri(.Item(z), 6) = veri(.Item(z), 6) + a(i, 5) ' var ise dizinin 6.elemaına a değişkeninin 5.kolonunu topla
End If
Next i
End With
'*******************************************
sat = s2.[a65536].End(3).Row + 1
s2.Range(Cells(2, "a"), Cells(sat, "J")).ClearContents
s2.[a2].Resize(n, 10).Value = veri ' veriyi yaz.
''*******************************************
MsgBox "Bitti"
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[hsayar]

Teşekkür ederim hocam

 

[hsayar]

sn ripek hocam kodları biraz açıklarmısınız?
bir çok sorunuma çözüm olabilecek gibi geldi ama hücre aralıkları birleşik olmayabilir.

 

[Recep İpek]

sn ripek hocam kodları biraz açıklarmısınız?
...

Kodlar üzerinde açıklamaya çalıştım.Bununla ilgili örnekleri incelemenizi tavsiye ederim.

 

[hsayar]

Hocam açıklamalarınız için teşekkür ederim...
Ancak bir kaç anlamadığım nokta var yardım ederseniz seviniirm. e forumda vu kodların kullanımı ile ilgili diğer linkler nerededir?


.CompareMode = vbTextCompare
____________'nedemektir?
If Not .exists(z) Then ' ve nesne içersinde yok ise
____________nasıl bir kontrol anlamadım.

s2.[a2].Resize(n, 10).Value = veri ' veriyi yaz.
____________Resize komutu hakkında biraz daha açıklmaa yapabilrimisinzi.