İki Sütunlu Benzersizleri Diğer Sayfaya Alfabetik Listelemek

Believing

Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
700
Excel Vers. ve Dili
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
Altın Üyelik Bitiş Tarihi
23-08-2028
Sayın Formdaş arkadaşlar,

Eketeki çalışmada iki sütundaki verileri "ÖZET" isimli sayfada benzersizlerinin listelenmesini yapmak istiyorum.
"DATABASE" isimli sayfanın "B4:C" aralığındaki verileri, "ÖZET" isimli sayfanın "E4:F" aralığına alfabetik benzersizlerini listelemek istiyorum.
Listeler sürekli değişkenlik gösterdiğinden manuel olarak yaptığım, yenilenenleri kaldır ve alfabetik olarak sırala, işlemlerinden kurtulmak için çok değerli yardımlarıza ihtiyacım vardır.
Benim için çok değerli olan yardımlarınızı rica ediyorum.

Saygılarımla,
 

Ekli dosyalar

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Ekli dosyayı deneyin....

Not: Dosya kaldırıldı...
.
 
Son düzenleme:

Believing

Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
700
Excel Vers. ve Dili
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
Altın Üyelik Bitiş Tarihi
23-08-2028
Sayın Haluk bey,

Konuya gösterdiğiniz ilgi ve yardım için çok teşekkür ederim.
Ellerinize ve emeğinize sağlık.
Bu benzersizleri birleştirerek değilde "E" ve "F" sütunlarına birleştirmeden yazılmasını nasıl sağlarız?

Saygılarımla,
 

Believing

Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
700
Excel Vers. ve Dili
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
Altın Üyelik Bitiş Tarihi
23-08-2028
Sayın Haluk bey,

Ellerinize emeğinize sağlık.
ALLAH sizden ve sevdiklerinizden razı olsun.
Hakkınızı helal ediniz lütfen.

Saygılarımla,
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,330
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bu da excelin yerleşik özellikleri ile alternatif olsun.

C++:
Option Explicit

Sub Iki_Sutuna_Gore_Benzersiz_Alfabetik_Liste()
    Dim S1 As Worksheet, S2 As Worksheet
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("DATABASE")
    Set S2 = Sheets("ÖZET")
    
    S2.Range("E4:F" & S2.Rows.Count).Clear
    
    If S1.Cells(S1.Rows.Count, 1).End(3).Row > 3 Then
        S1.Range("B4:C" & S1.Cells(S1.Rows.Count, 1).End(3).Row).Copy
        S2.Range("E4").PasteSpecial
        
        With S2.Range("E4:F" & S2.Rows.Count)
            .RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
            .Sort .Cells(1, 1), xlAscending, .Cells(1, 2), , xlAscending
        End With
    End If
    
    Set S1 = Nothing
    Set S2 = Nothing

    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 

Believing

Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
700
Excel Vers. ve Dili
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
Altın Üyelik Bitiş Tarihi
23-08-2028
Sayın Korhan bey,

Ellerinize emeğinize sağlık. Adeta hızır gibisiniz Korhan bey.
ALLAH sizden ve sevdiklerinizden razı olsun.
Hakkınızı helal ediniz lütfen.

Saygılarımla,
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,330
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Hakkım varsa helal olsun..
 
Üst