Yalnız Mesajı Göster
Eski 02-02-2015, 13:47  
Korhan Ayhan
Moderatör
 
Korhan Ayhan kullanıcısının avatarı
 
Giriş: 15/03/2005
Şehir: ANTALYA
Mesaj: 22,640
Excel Vers. ve Dili:
OFFICE 2013-2016 PRO TR
Varsayılan

Aşağıdaki kod çift sütuna göre benzersiz verileri listeler.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub BENZERSİZ_ÇİFT_SÜTUN()
    Dim s As Object, liste(), dizi()
    
    Son = Sheets(1).Cells(Rows.Count, "a").End(3).Row
    liste = Sheets(1).Range("a2:b" & Son).Value
    
    ReDim dizi(1 To Son, 1 To 2)
    
    Set s = CreateObject("Scripting.Dictionary")
    
    For i = 1 To UBound(liste, 1)
        Aranan = liste(i, 1) & liste(i, 2)
        If Not s.exists(Aranan) Then
            s.Add Aranan, Nothing
            Say = Say + 1
            ReDim Preserve dizi(1 To Son, 1 To 2)
            dizi(Say, 1) = liste(i, 1)
            dizi(Say, 2) = liste(i, 2)
        End If
    Next i
    
    Sheets(2).Range("A2").Resize(s.Count, 2) = dizi
End Sub
__________________
.
.
.

Soru sormadan önce forumumuzun aşağıdaki
bölümlerini incelediğinizde birçok sorunuza yanıt bulabilirsiniz.


Excel Dersanesi
Uygulamalı Excel Eğitimi
Excel İçin Örnek Uygulamalar
Video Dersane (***Altın Üyelere Özel***)

Lütfen sorularınızın çözümlendiğine dair geri dönüş mesajı yazınız...!
Lütfen yazım ve forum kurallarına uyalım...!
Lütfen sorularımızı açık ve net bir dille ifade edelim...!



FORUM KURALLARI
Korhan Ayhan Çevrimdışı   Alıntı Yaparak Cevapla