mükerrer kayıt ile ilgili

[tatarcık]

arkadaşlar ekli örnek te açıklamaya çalıştım ama kısaca burudada açıklamaya çalışayım
1-bir çalışma sayfam var ödeme defteri adı altında yaptığım her ödemeyi kayıt ediyorum
2-yaptığm kayıt sayısı arttıkça ödeme yapılan kişi sayısının aldığı ödül sayısı tutarı ile ilgili bilgi istenildiğinde bilgi almak zorlaşıyor
3- bu nedenle diğer bir çalışma sayfasına (ödeme Bilgi)'ye mükerrer kayıtlar toplamış mükerrer olmayan kayıtlarda aktarılmış bir sekilde aktarım yapılabilinir mi
yardımlarınızı bekliyorum

acilen lütfen

 

[tatarcık]

arkadaşlar yardımlarınızı bekliyorum lütfen

 

[halit3]

Bunu denermisiniz.

Sub aktar()
Sheets("genel ödeme bilgi").Range("A2:I65000").ClearContents
sat = 2
For r = 2 To Worksheets("ödeme defteri").Cells(Rows.Count, "c").End(3).Row
aranan1 = Sheets("ödeme defteri").Cells(r, "c").Value
say7 = 0
say8 = 0
If Sheets("ödeme defteri").Cells(r, "c").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("ödeme defteri").Range("C2:C" & r), aranan1) = 1 Then
For i = r To Worksheets("ödeme defteri").Cells(Rows.Count, "C").End(3).Row
aranan2 = Sheets("ödeme defteri").Cells(i, "C").Value
If aranan2 = aranan1 Then
say7 = say7 + CDbl(Sheets("ödeme defteri").Cells(i, 7).Value)
say8 = say8 + CDbl(Sheets("ödeme defteri").Cells(i, 8).Value)
End If
Next i
Sheets("genel ödeme bilgi").Cells(sat, 1).Value = Sheets("ödeme defteri").Cells(r, 1).Value
Sheets("genel ödeme bilgi").Cells(sat, 2).Value = Sheets("ödeme defteri").Cells(r, 2).Value
Sheets("genel ödeme bilgi").Cells(sat, 3).Value = Sheets("ödeme defteri").Cells(r, 3).Value
Sheets("genel ödeme bilgi").Cells(sat, 4).Value = Sheets("ödeme defteri").Cells(r, 4).Value
Sheets("genel ödeme bilgi").Cells(sat, 5).Value = Sheets("ödeme defteri").Cells(r, 5).Value
Sheets("genel ödeme bilgi").Cells(sat, 6).Value = Sheets("ödeme defteri").Cells(r, 6).Value
Sheets("genel ödeme bilgi").Cells(sat, 7).Value = say7
Sheets("genel ödeme bilgi").Cells(sat, 8).Value = say8
Sheets("genel ödeme bilgi").Cells(sat, 9).Value = Sheets("ödeme defteri").Cells(r, 9).Value
sat = sat + 1
End If
End If
Next r
MsgBox "İŞLEM TAMAM"
End Sub

 

[tatarcık]

Bunu denermisiniz.

SAYIN halit3 vermiş olduğunuz kodu kendi çalışma sayfama göre uyarladım
ama ödül tutarı ile ödeme toplamını toplama yaparak aktarma yapmıyor
tarih kısımlarını iptal edip ödül toplamı ve tutarını toplayarak aktarım yapılabilirmisiniz
veya
ödeme deefterine her bir kayıt eklendiğinde yapılacak bir fonksiyon ile kendi kendine ekleme yapılabilinir mi
bu konuda yardımlarınızı bekliyorum
düzenlediğim vba kodu aşağıdaki gibidir

Sub aktar()
Sheets("genel ödeme bilgi").Range("A2:I65000").ClearContents
sat = 2
For r = 2 To Worksheets("ÖDEME DEFTERİ").Cells(Rows.Count, "c").End(3).Row
aranan1 = Sheets("ÖDEME DEFTERİ").Cells(r, "c").Value
say7 = 0
say8 = 0
If Sheets("ÖDEME DEFTERİ").Cells(r, "c").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("ÖDEME DEFTERİ").Range("C5:C" & r), aranan1) = 1 Then
For i = r To Worksheets("ÖDEME DEFTERİ").Cells(Rows.Count, "C").End(3).Row
aranan2 = Sheets("ÖDEME DEFTERİ").Cells(i, "C").Value
If aranan5 = aranan1 Then
say7 = say7 + CDbl(Sheets("ÖDEME DEFTERİ").Cells(i, 7).Value)
say8 = say8 + CDbl(Sheets("ÖDEME DEFTERİ").Cells(i, 8).Value)
End If
Next i
Sheets("genel ödeme bilgi").Cells(sat, 1).Value = Sheets("ÖDEME DEFTERİ").Cells(r, 1).Value
Sheets("genel ödeme bilgi").Cells(sat, 2).Value = Sheets("ÖDEME DEFTERİ").Cells(r, 2).Value
Sheets("genel ödeme bilgi").Cells(sat, 3).Value = Sheets("ÖDEME DEFTERİ").Cells(r, 3).Value
Sheets("genel ödeme bilgi").Cells(sat, 4).Value = Sheets("ÖDEME DEFTERİ").Cells(r, 4).Value
Sheets("genel ödeme bilgi").Cells(sat, 5).Value = Sheets("ÖDEME DEFTERİ").Cells(r, 5).Value
Sheets("genel ödeme bilgi").Cells(sat, 6).Value = Sheets("ÖDEME DEFTERİ").Cells(r, 6).Value
Sheets("genel ödeme bilgi").Cells(sat, 7).Value = say7
Sheets("genel ödeme bilgi").Cells(sat, 8).Value = say8
Sheets("genel ödeme bilgi").Cells(sat, 9).Value = Sheets("ÖDEME DEFTERİ").Cells(r, 9).Value
sat = sat + 1
End If
End If
Next r
MsgBox "İŞLEM TAMAM"
End Sub

 

[halit3]

c sutünundaki isimlere göre toplama işlemlerini yapıyor yani aynı isimde kaç adet varsa onları topluyor.

 

[tatarcık]

birde bu örneğe bakarmısınız

c sutünundaki isimlere göre toplama işlemlerini yapıyor yani aynı isimde kaç adet varsa onları topluyor.

evet halit3 bey sizin örnekte ki vba çalışıyor bunu kendime göre yapmaya çalıştım olmadı ekli örneğe bakabilirmisiniz
teşekkürler

 

[halit3]

dosyanızda avast anti virüs proğramı virüs uyarısı aldı ve indiremedim boyutuda çok büyük dosyanızın

 

[tatarcık]

dosyanızda avast anti virüs proğramı virüs uyarısı aldı ve indiremedim boyutuda çok büyük dosyanızın

o virüs her excel çalışma sayfasında modülenin içinde laruox diye kendiğilinden vba kodu oluşturuyor sanırım o onu nasıl silebiliriz bilginiz var mı?

 

[halit3]

o virüs her excel çalışma sayfasında modülenin içinde laruox diye kendiğilinden vba kodu oluşturuyor sanırım o onu nasıl silebiliriz bilginiz var mı?

hiç bir fikrim yok

 

[tatarcık]

Topla Çarpım

arkadaşlar isteğim bitmiyor kusuruma bakmayın
daha önce sayın halit3 mükerrer kayıt birleştirme yaptı
halit beyin ve sizlerin sayesinde 1. aşamayı geçtim
şimsi ise yapılan ödemeleri kişi bazında ayrıtılı icmali isteniyor
ben topla çarpınım yolu ile yapmaya çalıştım ama tam sonuca ulaşamadım çünkü mükerrer kayıtlar var bu konu ile ilgili yardımlarınızı bekiyorum örnek ek tedir