Benzer sayılar kaç adet.

Katılım
1 Nisan 2008
Mesajlar
39
Excel Vers. ve Dili
2010 tr
Merhaba arkadaşlar.
Belki forumda vardır ama ben bulamadım. İstedigim basit olabilir ama ben başaramadım.
Sorum şu.
A1:A8 aralığında ki hücrelerde sayılar var. Ben (mesela B1 hucresinde) bu aralıkta kaç tane benzer sayı var görmek istiyorum. Bunu yapmak mümkün mü? Yardımlarınız için şimdiden teşekkürler. İyi günler.
 

Murat OSMA

Altın Üye
Altın Üye
Katılım
23 Mayıs 2011
Mesajlar
5,508
Excel Vers. ve Dili
Microsoft 365 TR-EN
Altın Üyelik Bitiş Tarihi
31-12-2028
Yani; aynı değerden en az 2 tane varsa onu 1 olarak mı sayacak ?
 
Katılım
31 Ocak 2012
Mesajlar
2,430
Excel Vers. ve Dili
Excel 2010 , Türkçe
Altın Üyelik Bitiş Tarihi
24.01.2019
Merhaba,

Eki inceleyiniz...

Kolay gelsin...
 
Son düzenleme:

Murat OSMA

Altın Üye
Altın Üye
Katılım
23 Mayıs 2011
Mesajlar
5,508
Excel Vers. ve Dili
Microsoft 365 TR-EN
Altın Üyelik Bitiş Tarihi
31-12-2028
Alternatif...

Fonksiyon ile;
Kod:
Function farkli(ByVal Alan As Range)
    For i = 1 To Range("A65536").End(3).Row
        If WorksheetFunction.CountIf(Range("A1:A" & i), Cells(i, "A")) = 2 Then
            say = say + 1
        End If
    Next i
    farkli = say
End Function
Ado ile;
Kod:
Public evn As String, baglan As Object

Public Sub baglanti()
    Set baglan = CreateObject("ADODB.Connection")
    baglan.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=yes"""
End Sub

Sub suz()
    Dim rs As Object
    Set rs = New ADODB.Recordset
    baglanti
    Sayfa1.Range("c2:E65000").ClearContents
    evn = "SELECT veri,count(veri) from [Sayfa1$] where veri = veri group by veri having count (veri)<>1 "
    rs.Open evn, baglan, 1, 3
    Sayfa1.Range("c2").CopyFromRecordset rs
    baglan.Close
    evn = Empty
    MsgBox "İşlem Tamamlandı" & " Www. "
End Sub
Dosyalar ek'tedir...
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,747
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Alternatif olarak formülle çözüm;

Kod:
=TOPLA.ÇARPIM((1/EĞERSAY(A1:A8;A1:A8)<1)*(1/EĞERSAY(A1:A8;A1:A8)))
 
Üst