Metni Sütunlara Dönüştür ve Sırala Makrosu

[meleklerim]

Arkadaşlar Merhaba,
1 sütunda içinde birbirinden "," ile ayrılmış veriler var.
Bu verilerin tek sütuna sıralanmasını ama aynı olanların ayıklanmasını istiyorum

Örnek
A Sütunu
1-ali, veli, can
2-ali
3-osman, murat
4-veli, ayşe, mehmet, selami
5-
6-can

şeklide ise
Bu verilerin aynılarının tekile düşürülüp
her hücrede bir veri olacak şekilde alt alta sıralanmasını düzenleyecek bir makroya ihtiyacım var.

YANİ
B SÜTUNU
ali
veli
can
osman
murat
ayşe
mehmet
selami

şekline dönüşmesi gerekiyor.

örnek dosya ekte. selamlar ve teşekkürler

http://dosya.co/2po360crv91z/Kitap2.xlsx.html

 

[Orion1]

Dosyanız aşağıdaki linktedir.

DOSYAYI İNDİR

Sub tekeindir59()
Dim sonsat As Long, i As Long, liste, deg, j As Integer, z As Object
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
liste = Range("A1:A" & sonsat).Value
Set z = CreateObject("Scripting.dictionary")
Range("B:B").ClearContents
For i = 1 To UBound(liste)
    deg = Split(liste(i, 1), ",")
    For j = 0 To UBound(deg)
        If Not z.exists(deg(j)) Then
            z.Add deg(j), Nothing
        End If
    Next j
Next i
Application.ScreenUpdating = False
Range("B1").Resize(z.Count, 1) = Application.Transpose(z.keys)
Set z = Nothing
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[meleklerim]

çok teşekkrüler, yalnız şöyle bir hataya sebep oluyor

Virgülden sonraki verileri alırken virgülden sonraki boşluğu da alıyor. O zaman da aynı veri olmasına rağmen farklı bir veriymiş gibi işlem yapıyor..

Biraz karışık ifade gibi gelebilir ama

Örneğin
Yılmaz Güney, Atıf Yılmaz
Atıf Yılmaz, Yılmaz Güney

satırlarında işlem yapsa,
Atıf Yılmaz
Yılmaz Güney

olarak 2 veri şekline dönüştürmesi istenirken

(boşluk) Atıf Yılmaz
(boşluk) Yılmaz Güney
Atıf Yılmaz
Yılmaz Güney

olarak 4 veri şekline getiriyor

, den sonraki boşluğu silip öyle ayıklaması lazım

selamlar

 

[meleklerim]

Şöyle çözdüm

bu satırdaki "," ifadesini ", " olarak değiştirdim, istediğim gibi oldu

deg = Split(liste(i, 1), ",")

deg = Split(liste(i, 1), ", ")

biraz mantık var ama tamamen tesadüfen çözdüm

 

[Emir Hüseyin Çoban]

. . .

İlgili satırı şu şekilde değiştirerek deneyiniz...

z.Add [COLOR="DarkRed"][B]Trim([/B][/COLOR]deg(j)[B][COLOR="DarkRed"])[/COLOR][/B], Nothing

. . .