Hücredeki değerleri alfabetik sıralama

[uuthbey]

Selamlar,
elimde yoğun bir data var. Bu datayı sadeleştirerek kontrol edilmesi daha kolay bir hale getirmeye çalışıyorum. Satırlar aşağıdaki şekilde oluşuyor:

SİVAS/ TOKAT/ YOZGAT/ ERBAA
SİVAS/ TOKAT/ YOZGAT/ SİVAS/ ERBAA
SİVAS/ TOKAT/ YOZGAT/ SİVAS/ ERBAA

Bunların her biri bir satırda yer alıyor. Gördüğünüz gibi değer iki veya üç kere yazılmış olabiliyor. Yapmaya çalıştığım şey şu: bir hücredeki değerlerin tekrar edenlerini kaldırmak ve hücredeki bu değerleri aşağıdaki şekilde alfabetik sıralamak:

ERBAA / SİVAS / TOKAT / YOZGAT
ERBAA / SİVAS / TOKAT / YOZGAT
ERBAA / SİVAS / TOKAT / YOZGAT

Şimdiden yardımlarınız için teşekkür ediyorum.

 

[Sarigol_937]

Sub BenzerSil()
For i = [A65536].End(3).Row To 2 Step -1
If Cells(i, "A") = Cells(i - 1, "A") Then Rows(i).Delete
Next i
End Sub


Necdet Yeşertener'den alıntıdır.

 

[uuthbey]

Teşekkür ederim, ancak işe yaramadı maalesef.

 

[uuthbey]

vermiş olduğunuz kod, sütun boyunca aynı içeriğe sahip satırları siliyor. bir nevi "yinelenenleri kaldır".
ben değişiklik sadece hücre içerisinde olsun istiyorum.

 

[uuthbey]

yardımcı olabilecek var mı?

 

[ÖmerBey]

Biraz karışık oldu ama idare edin artık.
Bu kadar yapabildim

A1'den itibaren A sütunundaki verilerin tekrarlılarını siler ve yine A sütununa alfabetik olarak sıralar.

Sub duzenle()
ayrac = "/ "
For j = 1 To [A65500].End(3).Row
k = Len(Cells(j, 1)) - Len(WorksheetFunction.Substitute(Cells(j, 1), "/", "")) + 1
    For i = 1 To k
    On Error Resume Next
    Cells(j, i + 20) = Split(Cells(j, 1), ayrac)(i - 1)
        For m = 21 To i + 20
        If Cells(j, i + 20) = Cells(j, m) Then say = say + 1
        Next m
        If say > 1 Then Cells(j, i + 20) = ""
        say = 0
    Next i
Range("U" & j & ":BA" & j).Sort Key1:=Range("U" & j), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
    For Z = 21 To 30
        If Cells(j, Z) = "" Then
        ElseIf yaz = "" Then
        yaz = Cells(j, Z)
        Else: yaz = yaz & ayrac & Cells(j, Z)
        End If
    Next Z
Cells(j, 1) = yaz
yaz = ""
Next j
Columns("U:BA").ClearContents
End Sub

 

[uuthbey]

çok ama çok teşekkür ederim üstad. emeğinize aklınıza sağlık. tam işime yarayacak şekilde olmuş.

 

[ÖmerBey]

Rica ederim, iyi çalışmalar...

 

[sahin1225]

A ve B sütunu veya farklı sütunlar için de aynı işlemi yapmak için kod'da nerede değişiklik yapmamız gerekiyor.

 

[excel41]

A ve B sütunu veya farklı sütunlar için de aynı işlemi yapmak için kod'da nerede değişiklik yapmamız gerekiyor.

ALTERNATİF OLSUN

http://dosya.co/16cdwkmv2nct/ALFABETİK_SIRALI.xlsx.html

EKİ İNCELEYİN