Listeyi sıralayıp aynıları silip toplatmak??

[x_files_x]

Mrb arkadaşlar ben çok acemi bir excel kullanıcısı olarak sizden yardım bekliyorum bir konu hakkında; sorum şöyle ki elimde bir liste var, numaraları ve buna karsılık gelen para miktarları, ama liste dagınık bir sekilde öncelikle numarası sırasına göre sıralanması gerekiyor tabiki karsısınaki para miktarları karışmadan, sonra ise diyelim ki 123 numara dan 3 tane var bunları 2 tanesi silinecek ve silinmeden önceki karsısındaki para miktarları o tek kalanın karsısına yazılacak ,
Mehmet 3
Mehmet 5
Mehmet 7 olan deger

Mehmet 15 olarak deişecek ve yanındaki sütünada 3 yazacak cünkü Mehmet 3 tane aynı isimdi
son hali Mehmet 15 3 olacak

 

[apocalyt]

aşağıdaki kodu bir modüle kpyalayıp deneyin..

Sub daylight()
Application.ScreenUpdating = False
ben = 1
Range("a2:b1000").Sort key1:=Range("a2")
For x = 2 To [a10000].End(3).Row
If Cells(x, 1) = "" Then GoTo gel
For y = x + 1 To [a10000].End(3).Row
If Cells(x, 1) = Cells(y, 1) Then
ben = ben + 1
Cells(x, 2) = Cells(x, 2) + Cells(y, 2)
Rows(y).Delete
y = y - 1
Else
Cells(x, 3) = ben
ben = 1
Exit For
End If
Next y
Next x
gel:
Application.ScreenUpdating = True
End Sub

 

[x_files_x]

aşağıdaki kodu bir modüle kpyalayıp deneyin..

Sub daylight()
Application.ScreenUpdating = False
Range("a2:a1000").Sort key1:=Range("a2")
For x = 2 To [a10000].End(3).Row
If Cells(x, 1) = "" Then GoTo gel
For y = x + 1 To [a10000].End(3).Row
If Cells(x, 1) = Cells(y, 1) Then
Cells(x, 2) = Cells(x, 2) + Cells(y, 2)
Rows(y).Delete
y = y - 1
Else
Exit For
End If
Next y
Next x
gel:
Application.ScreenUpdating = True
End Sub

Çok özür diliyerek soruyorum, hiç bişi bilmeyen birisi icin anlatır mısın bu verdigini nereye yazıp nasıl calıstırıcam,

 

[sametozyavuz]

apocalyt beyin cevabını dosyanıza ekledim.
ama bu kodlar sadece bu dosyada çalışır.

 

[x_files_x]

Samet bey cok tşk ederim oldu, peki ben bunu başka belgde nasıl kullanıcam ? Birşey daha eklemeyi unutmusum da
Mehmet 3
Mehmet 7
Mehmet 5 değerlerini

Mehmet 15 ve yanındaki sutunada 3 yazması lazım, 3 yazacak cünkü mehmet in 3 tane aynı ismi vardı, özür dileyerek yardımlarınızı bekliyorum

 

[apocalyt]

meraba..yukarıdaki ilk mesajımdaki kodlarda düzenleme yaptım..yandaki sutunada adetleri yazıcak..
excel dosyanız açıkken alt+f11 tuşlarına basın..kodu oraya kopyalayın..çalıştırın..kolay gelsin..

 

[x_files_x]

Çok tşk ederim ALLAH sizlerden razı olsun inşAALLAH, işimi görüyor herşey çalıştı tek birşey daha sorucam sorun yok ama sadece ilerde degiştirebileyim die soruyorum, şimdi bu scripte A2 den başlayıp verileri girince calısıyor ve para kısmı bitisinigindeki sütünde ve adet sayısıda hemen yanındaki sütünde, ben diyelim ki bir sütün bosluk bırakmak istiyorum arada bölye yapınca script calısmıyor bunu nereden düzenlicez ? bir kac deger le oynadım ama calısmadı oyle yapınca Bakın iki örnek verdim birinde calısıyor digerinde neden calısmıyor arada bir sütün attım? nereyi düzenlemeliyiz

 

[apocalyt]

rica ederim. sizden de razıl olsun.ancak bir yerde ufak bir hata yapmışışım..sonuçların tümü yanlış çıkıcak bu nedenle..sanırım sizde kontrol etmemişsiniz..yukarıdaki mesajda tekrar düzelttim..ordan tekrardan kopyalayınız...sordugunuz sorulara gelince bir sutun fazla bırakmanız makronun çalışmasını etkiler..çünkü a sutununa göre yazılmış kodlar..bir sutun boşluk bırakırsanız makro da baya bir kısmı ona göre değiştirmeniz gerekir..ben vaktim olursa ona göre bişey yapmaya çalışırım..kolay gelsin.

 

[x_files_x]

Çok tşk ederim hocam, ben demek ki çok dikkatli bakmamışım, şuan denedim çalıştı, Elinize sağlık iyi bayramlar dilerim ,sağolun