Tek bir hücre içerisinde alt alta yazılan kelimeleri alfabetik sıralama nasıl yaparız?

Deniz_Excel

Altın Üye
Katılım
15 Mart 2016
Mesajlar
134
Excel Vers. ve Dili
MS Excel 2016
Altın Üyelik Bitiş Tarihi
23-10-2026
Merhaba herkese,

Yapmak istediğim linkteki gibi bir excelde rasgele tek hücre içerisinde alt alta yazılmış olan kelimeleri alfabetik olarak sıralamaktır. Bunu makrolu/makrosuz nasıl yapabiliriz?

Link:
 

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,127
Excel Vers. ve Dili
2007 Türkçe
Merhaba,
Deneyiniz...
Kod:
Sub kod()
Dim s1 As Worksheet, s2 As Worksheet
Dim temp As Range
Dim a As Long
Application.ScreenUpdating = False
Set s1 = ActiveSheet
Set s2 = Worksheets.Add
For a = 2 To s1.Cells(Rows.Count, 1).End(3).Row
    s = Split(s1.Cells(a, 1).Value, vbLf)
    Set temp = s2.Range("A1").Resize(UBound(s) + 1, 1)
    temp.Value = Application.Transpose(s)
    temp.Sort s2.Range("A1"), xlAscending
    s = Application.Transpose(temp.Value)
    temp.Clear
    s1.Cells(a, 2).Value = Join(s, vbLf)
Next
Application.DisplayAlerts = False
s2.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,226
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Alternatif olsun.
Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.

Örnek dosyada sıralı veriye B sütununa yazdırdım, siz A sütununa yazdırabilirsiniz.

Kod:
Sub Oku()

    Dim i As Long
    Dim d As Variant

    For i = 2 To Cells(Rows.Count, "A").End(3).Row
        d = Split(Cells(i, "A"), Chr(10))
        Cells(i, "B") = Bubble_Sort(d)
    Next i
    
End Sub
Kod:
Function Bubble_Sort(Arr As Variant) As String

    Dim strTemp As String
    Dim i As Long
    Dim j As Long
    Dim lngMin As Long
    Dim lngMax As Long
 
    lngMin = LBound(Arr)
    lngMax = UBound(Arr)
 
    For i = lngMin To lngMax - 1
 
        For j = i + 1 To lngMax
    
            If Arr(i) > Arr(j) Then
                strTemp = Arr(i)
                Arr(i) = Arr(j)
                Arr(j) = strTemp
            End If
      
        Next j
    
    Next i
    
    Bubble_Sort = Join(Arr, Chr(10))
    
End Function
 

Deniz_Excel

Altın Üye
Katılım
15 Mart 2016
Mesajlar
134
Excel Vers. ve Dili
MS Excel 2016
Altın Üyelik Bitiş Tarihi
23-10-2026
Necdet Bey ve Ömer Bey teşekkürler her iki kod da istediğim gibi çalışıyor.
 
Üst