• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Mükerrer verileri tek saydırma

Katılım
26 Kasım 2011
Mesajlar
27
Excel Vers. ve Dili
2003 EXCELL
WİNDOWS 7
Merhaba,

ben A sütununda 5 ali ismi var fromülle saydırmak istiyorum ama sonuç 1 çıkmalı , ayrıca sonucu sıfır çıkan formülde sıfırı görmek istemiyorum.

yardımcı olabilir misiniz ltf.
 
örnek olarak aradığın sütün a sununun 1 ile 10000 satırları arası yani a1:a10000 de ise arayacan değerde c2 de ise

=eğer(eğersay(a1:a10000;c2)>0;1;"") kullanabilirsin
 
Mükerrer veri süzüp toplama

Hocam yukarıdaki örnekleriniz için öncelikle teşekkür ederim. Benim şöyle bir sorunum var mükerrer olan verileri süzmek ve yanındaki değerleri toplamak.
Dosyada sarı ile işaretlediğim yeri formülle süzmek istiyorum. İnceleyebilirseniz çok sevinirim.

Şimdiden çok teşekkürler...
 

Ekli dosyalar

Merhaba,

Excel menülerini kullanarak yapabilirsiniz.

Veri / Filtre / Gelişmiş Filtre bölümüne girin / Liste aralığı bölümüne,

Sayfa1!$A$1:$B$13

*Başka bir yere kopyala seçeneğin işaretleyin.

Hedef bölümüne;

Sayfa1!$E$1

*Yalnızca benzersiz kayıtlar seçeneğini işaretleyin ve tamam butonu ile işlemi bitirin.
 
Merhaba,

Excel menülerini kullanarak yapabilirsiniz.

Veri / Filtre / Gelişmiş Filtre bölümüne girin / Liste aralığı bölümüne,

Sayfa1!$A$1:$B$13

*Başka bir yere kopyala seçeneğin işaretleyin.

Hedef bölümüne;

Sayfa1!$E$1

*Yalnızca benzersiz kayıtlar seçeneğini işaretleyin ve tamam butonu ile işlemi bitirin.

Ömer hocam öncelikle teşekkür ederim. Fakat Örnek dosyada da görüldüğü gibi benim verileri aldığım yer A ve B sütunları ve bu sütunlar asıl dosyamda formüllü ve sayıları devamlı değişiyor. Yani farklı bir dosyadan veri alıp burda güncelleme yapıyor. Benim istediğim ise A ve B sütunundaki verilerin otomatik olarak formülle süzülerek E ve F sütunlarına gelmesi.

Yardımlarınız için şimdiden çok teşekkürler.
 
Bu şekilde deneyin.

Kod:
Sub Ozet_Rapor()
 
    Dim s, a1, a2, deg, i As Long, d As Object
        
    Set d = CreateObject("Scripting.Dictionary")
    Range("E:G").ClearContents
    
    Range("A1:C1").Copy Range("E1")
    
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        deg = Cells(i, "A") & "|" & Cells(i, "B")
        If Not d.exists(deg) Then
            d.Add deg, Cells(i, "C")
        Else
            s = d.Item(deg)
            s = s + Cells(i, "C")
            d.Item(deg) = s
        End If
    Next i
    
    a1 = d.keys: a2 = d.items
    
    For i = 0 To d.Count - 1
        Cells(i + 2, "E") = Split(a1(i), "|")(0)
        Cells(i + 2, "F") = CDbl(Split(a1(i), "|")(1))
        Cells(i + 2, "G") = a2(i)
    Next i
 
End Sub
.
 
Ömer hocam size sorduğum örnekte ufak bir detayı atlamışım onun dışında sistem çok güzel bir şekilde çalışıyor. Benim için ufak olan detay sanırım bütün formülasyonu değiştirecektir ama yardımcı olabilirseniz çok sevinirim. Problem şu sıralama yaparken A sütunundaki çap değeri ve ardından da B sütunundaki Et kalınlığı değerine göre sıralama yapmasını istiyorum. Ekteki dosyada inceleyebilirsiniz.
 

Ekli dosyalar

Bu şekilde deneyin.

Kod:
Sub Düğme1_Tıklat()
 
    Dim s, a1, a2, deg, i As Long, d As Object
        
    Set d = CreateObject("Scripting.Dictionary")
    Range("E:G").ClearContents
    
    Range("A1:C1").Copy Range("E1")
    
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        deg = Cells(i, "A") & "|" & Cells(i, "B")
        If Not d.exists(deg) Then
            d.Add deg, Cells(i, "C")
        Else
            s = d.Item(deg)
            s = s + Cells(i, "C")
            d.Item(deg) = s
        End If
    Next i
    
    a1 = d.keys: a2 = d.items
    
    For i = 0 To d.Count - 1
        Cells(i + 2, "E") = Split(a1(i), "|")(0)
        Cells(i + 2, "F") = CDbl(Split(a1(i), "|")(1))
        Cells(i + 2, "G") = a2(i)
    Next i
[COLOR=blue]    
    Range("E:G").Sort Key1:=Range("E1"), Order1:=xlAscending, _
                        Key2:=Range("F1"), Order2:=xlAscending
[/COLOR]            
End Sub
.
 
Ömer hocam çok teşekkür ederim. Çok sağolun...

İyi çalışmalar...
 
Geri
Üst