Hücre içindeki sayıları sıralama

[yolcuhan]

Merhabalar. Forumda ve nette arama yapsamda aradığımı bulamadım.
Bir hücrenin içeriği misal; 23,4,15,17,9 gibi.
Bu sayıları sıraya dizerek; 4,9,15,17,23 haline nasıl getiririz.
Kanaatimce makroyla yapılacak fakat makrodan fazla anlamıyorum.
Yardımcı olabilecek arkadaşlara teşekkür ederim.

 

[sakman26]

Merhaba,

Yardımcı kolonlar kullanarak formüllerle çözmeye çalıştım.

Eki inceleyiniz...

Kolay gelsin...

 

[Necdet]

Merhaba,

A sütunundaki istediğiniz gibi yazılan değerleri B sütununda sıralar.

Kodları kendi çalışmalarınıza uyarlayınız.

Sub Sirala()
    
    Dim i   As Integer, _
        j   As Integer, _
        k   As Integer, _
        Temp As Variant, _
        s
    
    For k = 1 To Cells(Rows.Count, "A").End(3).Row
        s = Split(Cells(k, "A"), ",")
        Cells(k, "B") = ""
        For i = 0 To (UBound(s) - 1)
           For j = i To UBound(s)
              If Val(s(j)) < Val(s(i)) Then
                 Temp = s(i)
                 s(i) = s(j)
                 s(j) = Temp
              End If
           Next j
        Next i
        
        For i = 0 To UBound(s)
            If Cells(k, "B") = "" Then
                Cells(k, "B") = s(i)
            Else
                Cells(k, "B") = Cells(k, "B") & ", " & s(i)
            End If
        Next i
    Next k
    
End Sub

 

[Korhan Ayhan]

Merhaba,

Bende alternatif olarak kullanıcı tanımlı fonksiyon hazırladım. Bu şekilde değişik ayıraçlarla ayrılmış sayıları sıralayabilirsiniz.

Hücrede kullanım şekli;

=DİZİLİM(A1;",")

Kullanılan fonksiyon;

Option Explicit

Function DİZİLİM(Veri As Range, Optional Ayırac As String = ",")
    Dim Eleman, X, Dizi, Say, Liste
    
    Application.Volatile True
    
    Eleman = Split(Veri.Text, Ayırac)
    ReDim Dizi(1 To 1)
    
    For X = 0 To UBound(Eleman)
        Say = Say + 1
        ReDim Preserve Dizi(1 To Say)
        Dizi(Say) = CDbl(Eleman(X))
    Next
    
    For X = 0 To UBound(Eleman)
        If Liste = "" Then
            Liste = WorksheetFunction.Small(Dizi, X + 1)
        Else
            Liste = Liste & "," & WorksheetFunction.Small(Dizi, X + 1)
        End If
    Next
    
    DİZİLİM = Liste
End Function

 

[yolcuhan]

sakman26,
Necdet Yeşertener,
Korhan Ayhan,
arkadaşlar yardımlarınız için çok teşekkürler.
İyi çalışmalar.

 

[qazxswedc321]

Merhaba,

Korhan ayhan Bey'in yazmış olduğu makroyu kullandım, ancak virgülden sonra boşluk bırakmıyor, yani rakamlar şöyle oluyor: 1,5,7,9

Virgülden sonra boşluk kalması için makronun nasıl olması gerekiyor? Yani şu şekilde: 1, 5, 7, 9 (son rakamdan sonra boşluk bırakmasın).

Yardımcı olabilirseniz sevinirim.

İyi günler

 

[veyselemre]

Sub siralaAZ()
    For i = 1 To Cells(Rows.Count, 1).End(3).Row
        sirala = Replace(Cells(i, 1), " ", "")
        bol = Split(sirala, ",")
        For X = 0 To UBound(bol) - 1
            For y = X + 1 To UBound(bol)
                If bol(X) > bol(y) Then
                    tmp = bol(X)
                    bol(X) = bol(y)
                    bol(y) = tmp
                End If
            Next y
        Next X
        Cells(i, 2) = Join(bol, ", ")
    Next i
End Sub

 

[Korhan Ayhan]

Boşluk için fonksiyonu aşağıdaki şekilde kullanmalısınız.

Değiştirdiğim bölümü kırmızı renkle belirttim.

Option Explicit

Function DİZİLİM(Veri As Range, Optional Ayırac As String = ",")
    Dim Eleman, X, Dizi, Say, Liste
    
    Application.Volatile True
    
    Eleman = Split(Veri.Text, Ayırac)
    ReDim Dizi(1 To 1)
    
    For X = 0 To UBound(Eleman)
        Say = Say + 1
        ReDim Preserve Dizi(1 To Say)
        Dizi(Say) = CDbl(Eleman(X))
    Next
    
    For X = 0 To UBound(Eleman)
        If Liste = "" Then
            Liste = WorksheetFunction.Small(Dizi, X + 1)
        Else
            [COLOR="Red"]Liste = Liste & ", " & WorksheetFunction.Small(Dizi, X + 1)[/COLOR]
        End If
    Next
    
    DİZİLİM = Liste
End Function

 

[qazxswedc321]

Çok teşekkür ederim, çok sağolun.