Mdemir63
Altın Üye
- Katılım
- 7 Temmuz 2006
- Mesajlar
- 2,882
- Excel Vers. ve Dili
- Ofis2010 32Bit Türkçe
- Altın Üyelik Bitiş Tarihi
- 19-02-2026
@veyselemre öncelikle elinize sağlık hem kodlar kısa hem de süre kısa.Linkteki dosya üzerinde hazırlanmıştır.
Kod:Sub TekrarSayilariGetir() Dim veri, liste, kys, itms, i%, ii%, iii% With Sheets("Sayfa1") veri = .Range("N2:AO" & .Cells(Rows.Count, "N").End(3).Row).Value ReDim liste(1 To UBound(veri), 1 To UBound(veri, 2) * 2) End With With CreateObject("Scripting.Dictionary") For i = 1 To UBound(veri, 2) .RemoveAll For ii = 1 To UBound(veri) If veri(ii, i) <> "" Then .Item(veri(ii, i)) = .Item(veri(ii, i)) + 1 Next ii If .Count > 0 Then kys = .keys itms = .items For iii = 0 To UBound(kys) liste(iii + 1, ((i - 1) * 2) + 1) = kys(iii) liste(iii + 1, ((i - 1) * 2) + 2) = itms(iii) Next iii End If Next i End With With Sheets("Sayfa2") .Range("A2:BD100").ClearContents .Range("A2").Resize(UBound(liste), UBound(liste, 2)).Value = liste For i = 1 To UBound(liste, 2) Step 2 .Cells(1, i).Resize(UBound(liste), 2).Sort Key1:=.Cells(1, i), Header:=xlYes Next i End With MsgBox "Tekrar eden sayılar ilgili alanlara yazıldı." & Chr(10) & _ "Karşılarına Tekrar Sayıları Getirildi.", vbInformation, Application.UserName End Sub
Yalnız, sizin kodlarınızda 1 defa tekrar edenler de listeleniyor. sadece 1 den fazla tekrar edenleri listelemek
için kodlarınızda nasıl bir değişiklik yapılabilir?