İsim Ayıklayıp Yazdırmak

[mor45]

A SÜTUNUNDA:ALİ-KAZIM-İSA-MURAT Yazılı
B Sütununda : ALİ-İSA-MURAT Yazılı
C Sütununda : RECEP-İSA -HASAN Yazılı
D Sütununda aynı olan adları yazmadan hepsini yazmasını istiyorum.
Yani:ALİ-KAZIM-İSA-MURAT-RECEP-HASAN gibi.Formül ile nasıl yazdırabilirim.
Yardımlarınızı bekliyorum.

 

[Ömer]

Merhaba,

İstenileni formül ile yapmak için birden çok yardımcı sütun kullanmanız gerekir. İşlemi oldukça uzatıp yavaşlatır, bu yüzden tavsiye etmem. Aşağıdaki kodları çalıştırın.
Verilerin 2.satırdan başlanıldığı düşünülmüştür.

Sub Benzersiz_Liste()

    Dim d As Object, i As Long, j As Integer, deg As String, s, t

    Set d = CreateObject("Scripting.Dictionary")
    
    Application.ScreenUpdating = False
    Range("D[COLOR="red"]2[/COLOR]:D" & Rows.Count).ClearContents
    
    For i = [COLOR="Red"]2[/COLOR] To Cells(Rows.Count, "A").End(xlUp).Row
        deg = Cells(i, "A") & "-" & Cells(i, "B") & "-" & Cells(i, "C")
        t = Split(Replace(deg, " ", ""), "-")
        For j = 0 To UBound(t)
            If Not d.exists(t(j)) Then
                s = t(j)
                d.Add t(j), s
                Cells(i, "D") = Cells(i, "D") & "-" & s
            End If
        Next j
        Cells(i, "D") = WorksheetFunction.Substitute(Cells(i, "D"), "-", "", 1)
    Next i
    
    Set d = Nothing
    Application.ScreenUpdating = True

End Sub

 

[mor45]

Hayır olmamış
d sütunun hepsini altalta yazmalıydı

 

[mor45]

Ekteki sonucç gibi olmalıydı.
altalta yazmalıydı. yanyana degil


ALİ
KAZIM
İSA
MURAT
RECEP
HASAN

 

[Ömer]

Yani:ALİ-KAZIM-İSA-MURAT-RECEP-HASAN.

İlk mesajınızda bu şekilde olması gerektiğini söylememiş miydiniz. Sorularınızı daha anlaşılır yöneltmenizi rica ederim.

Alt alt olacaksa, örneğin veriler A1 B1 C1 de diyelim istediğiniz gibi düzenledik. A2 B2 C2 de veri varsa bunları nereye yazacak.

Yada verileriniz A B C sütunlarında aralarında "-" simgesi olarak yan yana değilde, bu sütunlarda alt alta mı?

.

 

[mor45]

Evet sütünlarda alt alta yazılı. Eskiden örnek dosyayı gönderiyorduk buna göre kolay oluyordu.Şimdi gönderemiyoruz.
Ondan dolayı bende anlatırken yanlış anlatmış olabilirim.

A Sütunu B Sütunu C Sütunu D Sütunu ( Sonu Sütunu)
Ali Kayan Adem Küçük Rasim Uz Ali Kayan
Rıza Özsoy Rıza Özsoy Rıza Özsoy
Adem Küçük
Rasim Uz
anlatmak istediğim d sütunundaki gibi yazması bunu yapacağım bir formül
İlginize teşekkür ediyorum,

 

[mor45]

yazıları sütun olarak yazıyorum.
ama yine de satıra dönüştürüyor,
D Sütununda isimleri tektek yazmasın istedim çift olanlar yinelenmeyecek,

 

[Ömer]

Bu şekilde deneyin.

Verilerin 1 satırdan başlanıldığı düşünüldü.

Sub Benzersiz_Liste()

    Dim d As Object, son As Long, a As Range, sat As Long, deg

    Set d = CreateObject("Scripting.Dictionary")
    son = [A:C].Find("*", , , , xlByRows, xlPrevious).Row
    
    Application.ScreenUpdating = False
    Range("D1:D" & Rows.Count).ClearContents
    
    sat = 1
    For Each a In Range("A1:C" & son)
        deg = a.Value
        If Not d.exists(deg) Then
            d.Add deg, Nothing
            Cells(sat, "D") = a.Value
            sat = sat + 1
        End If
    Next a
    
    Set d = Nothing
    Application.ScreenUpdating = True

End Sub

.