• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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
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:
 
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
 
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
 
Necdet Bey ve Ömer Bey teşekkürler her iki kod da istediğim gibi çalışıyor.
 
Geri
Üst