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

Mdemir63 · 2 Nisan 2024

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 · 2 Nisan 2024

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?

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 · 2 Nisan 2024

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

@veyselemre hocam.
Elinize sağlık.
Ayrıca, öğrenmemize katkıda bulunduğunuz için çok teşekkür ederim.
Saygılar

aytunc75 · 2 Nisan 2024

Mdemir63' Alıntı:
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 · 2 Nisan 2024

neden belirli satır?

aytunc75 · 4 Nisan 2024

Mdemir63' Alıntı:
neden belirli satır?

Data çok yüklü olduğu için bazen belirli dönemlere ait verileri süzme ihityacı oluşuyor.

irfem4 · 4 Nisan 2024

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.

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.

aytunc75 · 4 Nisan 2024

irfem4' Alıntı:
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.

dosyayı indiremiyorum altın üyelik istedi. Başka indirme yolu var mı acaba?

aytunc75 · 5 Nisan 2024

irfem4' Alıntı:
mail adresi verirseniz mail atayım.

Yardımlarınız için teşekkür ederim.

aytunccaglayan@gmail.com

aytunc75 · 5 Nisan 2024

Mdemir63' Alıntı:
neden belirli satır?

Metin hocam bakabildiniz mi acaba?

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

Mdemir63

veyselemre

Özel Üye

Mdemir63

aytunc75

Mdemir63

aytunc75

irfem4

Ekli dosyalar

aytunc75

aytunc75

aytunc75

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