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

Mdemir63

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,889
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
19-02-2026
veyselemre' Alıntı:
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
Genişletmek için tıkla ...
@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

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,648
Excel Vers. ve Dili
Pro Plus 2021
Mdemir63' Alıntı:
@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?
Genişletmek için tıkla ...
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

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,889
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
19-02-2026
veyselemre' Alıntı:
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
Genişletmek için tıkla ...
@veyselemre hocam.
Elinize sağlık.
Ayrıca, öğrenmemize katkıda bulunduğunuz için çok teşekkür ederim.
Saygılar
 
A

aytunc75

Katılım
16 Ocak 2018
Mesajlar
20
Excel Vers. ve Dili
2007
Mdemir63' Alıntı:
Rica ederim.
İyi çalışmalar
Genişletmek için tıkla ...
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

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,889
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
19-02-2026
neden belirli satır?
 
irfem4

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
aytunc75' Alıntı:
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.
Genişletmek için tıkla ...
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

Cevap yazmak için giriş yap yada kayıt ol.
Üst