MÜKERRER KAYIT

[rainmans]

kolay gelsin arkadaşlar. Benim sorunum daha öncede sizlerin yardımıyma sayfa üzerinde bulunan kayıtlardaki mükerer kayıtları aşağıdaki makro ile buluyordum.
Sub mukerrer()
Columns("W:X").ClearContents
For a = 2 To Cells(65536, 6).End(xlUp).Row
Cells(a, 23) = Range("G" & a) & Range("F" & a) & Range("J" & a) & Range("K" & a)
If WorksheetFunction.CountIf(Range("W2:W" & a), Cells(a, 23).Value) > 1 Then Cells(a, 24) = "MÜKERRER KAYIT"
Next
End Sub

Ancak Excell de yaptığım tablomun şablonunu değiştirmek zorunda kaldım daha önce ceriler tek satırda iken bu kez her bir kayıt iki satırdan oluşuyor.
Makro üzerinde çalıştım ama başaramadım Yeni düzenlediğim dosya ekte dir yardımlarınızı bekliyorum

 

[Levent Menteşoğlu]

Yukarıda verdiğiniz kodun çalıştırıldığı dosyayıda eklermisiniz.

 

[rainmans]

dosyayı ekliyorum şimdiden teşekkürler.

 

[rainmans]

Yardımcı olmak isteyen yokmu?? :yardim:

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

[vb:1:7ef94a4401]Sub mukerrer()
Columns("W:X").ClearContents
For a = 4 To [e65536].End(xlUp).Row Step 2
Cells(a, "w") = Range("E" & a) & Range("E" & a + 1) & Range("F" & a) & Range("F" & a + 1) & Range("G" & a) & Range("G" & a + 1)
Next
For b = 4 To [w65536].End(xlUp).Row Step 2
If WorksheetFunction.CountIf(Columns("w"), Cells(b, "w").Value) > 1 Then Cells(b, "x") = "MÜKERRER KAYIT"
Next
End Sub
[/vb:1:7ef94a4401]

 

[rainmans]

Teşekkür ederim eline sağlık.