Tekrar eden sayıları ve bu sayıların tekrar adetlerini bulma

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
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
@veyselemre öncelikle elinize sağlık hem kodlar kısa hem de süre kısa.
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?
 

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,648
Excel Vers. ve Dili
Pro Plus 2021
@veyselemre öncelikle elinize sağlık hem kodlar kısa hem de süre kısa.
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?
Kod:
Sub TekrarSayilariGetir()
    Dim veri, liste, kys, itms, i%, ii%, iii%, say%

    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
                say = 1
                For iii = 0 To UBound(kys)
                    If itms(iii) > 1 Then
                        liste(say, ((i - 1) * 2) + 1) = kys(iii)
                        liste(say, ((i - 1) * 2) + 2) = itms(iii)
                        say = say + 1
                    End If
                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
 

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
Kod:
Sub TekrarSayilariGetir()
    Dim veri, liste, kys, itms, i%, ii%, iii%, say%

    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
                say = 1
                For iii = 0 To UBound(kys)
                    If itms(iii) > 1 Then
                        liste(say, ((i - 1) * 2) + 1) = kys(iii)
                        liste(say, ((i - 1) * 2) + 2) = itms(iii)
                        say = say + 1
                    End If
                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
@veyselemre hocam.
Elinize sağlık.
Ayrıca, öğrenmemize katkıda bulunduğunuz için çok teşekkür ederim.
Saygılar
 
Katılım
16 Ocak 2018
Mesajlar
20
Excel Vers. ve Dili
2007
Rica ederim.
İyi çalışmalar
Ufak bir sorum daha olacaktı.

Dosya 60.000 satırlık ve üzerine yeni satırların eklenmesi ile güncellenen bir dosya.
Acaba yapmış olduğunuz kodu sadece belirli satırlar arasında çalıştırabilirmiyiz?

İyi Çalışmalar
 

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
neden belirli satır?
 

irfem4

Altın Üye
Katılım
30 Kasım 2010
Mesajlar
183
Excel Vers. ve Dili
2010 tr
Altın Üyelik Bitiş Tarihi
25-09-2028
Merhaba,
Excel 1 sayfada A sütunu B sütunu ve C sütunu altında yaklaşık 50.000 satırlık data da rakamlar yazıyor.
Başka bir sayfada sütunlar altında tekrar eden sayıları ve kaç defa tekrar ettiğini nasıl bulabilirim acaba?
Data çok yüklü ve sürekli ilave bilgi gelmesi nedeniyle koşullu biçimlendirme ile istediğimi yapamadım.

Aşağıdaki örnek tabloda kırmızı ile işaretlediğim bölüm sayfa 1deki verileri yeşil ile başlıklarını yazdığım bölüm ise yapmak istediğim şeyi belirtmekte.

A sütunu

B sütunu

C sütunu

 

A sütunu Tekrar Eden Sayı

A sütunu Tekrar Eden Sayı Adedi

 

B sütunu Tekrar Eden Sayı

B sütunu Tekrar Eden Sayı Adedi

 

C sütunu Tekrar Eden Sayı

C sütunu Tekrar Eden Sayı Adedi

2,20

2,98

2,67

 

2,71

2

 

3,2

3

 

2,67

2

1,68

3,20

4,44

 

1,92

2

 

3

2

 

3,08

2

2,71

2,96

2,18

 

1,45

2

 

3,12

2

 

3,69

2

1,92

3,13

3,08

 

2,63

2

    

2,44

3

1,80

2,97

3,69

         

1,45

3,58

6,11

         

2,30

3,02

2,71

         

2,38

3,00

2,44

         

2,63

2,91

2,44

         

3,23

3,10

1,99

         

1,85

3,12

3,65

         

2,71

3,20

3,69

         

2,63

3,20

2,67

         

1,45

3,12

2,44

         

1,92

3,00

3,08

         

Yardımlarınızı rica ederim.
Formül ile 100 satırlık dosya hazırladım. belki işinize yarar. satır sayısını formül içinden arttırabilirsiniz.
 

Ekli dosyalar

Üst