Tekrar eden kayıtlarla ilgili

[izcik]

Sub MUK()
[H:J].Clear
son = Application.CountA(Columns(1))

For t = 1 To son
    say = WorksheetFunction.CountIf(Columns(1), Cells(t, 1))
If say > 1 Then
    k = k + 1
    Cells(k, 8) = Cells(t, 1)
    Cells(k, 9) = Cells(t, 2)
    Cells(k, 10) = Cells(t, 3)
End If
Next
[H:J].Sort KEY1:=[H1]
End Sub

İyigünler, severek kullandığım bir dosyam var, kodları yukarıdaki gibidir.

A sütununda bir veri , birden fazla tekrar ediyorsa , düğmeye basıldığında , H sütununa birbirini tekrar eden kaç tane kayıt varsa onları gösteriyor.

Yani örnek olarak ,

A sütununda şunlar var

ALİ
KEMAL
AYŞE
FATMA
KEMAL
MEHMET
KEMAL
MEHMET
VELİ
MUSTAFA

Düğmeye basıldığında H sütununa

KEMAL
KEMAL
KEMAL
MEHMET
MEHMET

olarak görünüyor.

Sorunum şu. Galiba kodlarda A sütununun belli bir satırına kadar dahil edilmiş. Çünkü satır sayısı çok fazla olduğunda dosya görevini yapmıyor.

A sütununun tamamını (65536 satır) kapsayacak şekilde düzeltirmisiniz. Saygılar

 

[Erdem Akdemir]

son = Application.CountA(Columns(1))

A sütunundaki dolu hücre kadar işlem yapar.

Verinizde arada boşluklar varsa ondan eksik oluyordur.

 

[ZorBey_]

Denermisiniz.

Sub MUK()
[H:J].Clear
son = Application.CountA(Columns(1))
For t = 1 To Sheets("Sayfa1").[A65536].End(3).Row
    say = WorksheetFunction.CountIf(Columns(1), Cells(t, 1))
If say > 1 Then
    k = k + 1
    Cells(k, 8) = Cells(t, 1)
    Cells(k, 9) = Cells(t, 2)
    Cells(k, 10) = Cells(t, 3)
End If
Next
[H:J].Sort KEY1:=[H1]
End Sub

 

[izcik]

Hemen deniyorum arkadaşlar

 

[izcik]

son = Application.CountA(Columns(1))

A sütunundaki dolu hücre kadar işlem yapar.

Verinizde arada boşluklar varsa ondan eksik oluyordur.

Değerli kuvari , bravo , tıpkı dediğiniz gibi. Eksik olması o yüzdenmiş. Teşekkür ederim ilginize. Başarılar

(Verilerimin arasında boşluklar vardı)

 

[izcik]

Denermisiniz.

Sub MUK()
[H:J].Clear
son = Application.CountA(Columns(1))
For t = 1 To Sheets("Sayfa1").[A65536].End(3).Row
    say = WorksheetFunction.CountIf(Columns(1), Cells(t, 1))
If say > 1 Then
    k = k + 1
    Cells(k, 8) = Cells(t, 1)
    Cells(k, 9) = Cells(t, 2)
    Cells(k, 10) = Cells(t, 3)
End If
Next
[H:J].Sort KEY1:=[H1]
End Sub

Değerli Zorbey, tam istediğim kodları vermiş oldunuz. Teşekkür eder, iyi günler dilerim.

 

[randzafer]

Başarılı..