sıralama sorunu

[yakup123]

arkadaşlar merhaba ekteki dosyda sıralama yapmak ıstıyorum b kolonunda ama başta unvanlar oldugundan unvanlara gore sıralıyor ben ısme göre sıralasın ıstıyorum makroyla yapılıyor heralde yardım edebılırmısınız

 

[Vedat Özer]

Selamlar,

Bence sorunuzu biraz daha netleştirin.

uzm yrd ali bal
op dc murat ala
doc dok aylin can


Bu şekilde verileriniz var Bunları sıralamak için belli şarta göre makro veya formül yazılabilir ama burdaki şart neye göre olcak ilk başta 7 8 veya karakterden sonra isim mi olcak yoksa ünvan mı ?
Ben sorunuzu çözemem ama bir yol göstersim.

 

[yakup123]

yanı karakterler farklı ama standart bıse varsa ıkıncı soldan ıkıncı boşluktan sonra ısım gelıyor bende ısme gore sırlama yapmak ıstıyosam olabılır

 

[yakup123]

şölede olabılır soldan ikinci boşlugu bulup sonrakı karakteri getirse yan sütunda oda ismin ilk karakteri olur bende sıralamayı o sutuna gore yapsam oda olur

 

[yakup123]

baz bi yöntemle çözdüm teşekkür ederim arkadaşlar

 

[Orion1]

Dosyanız ektedir.

Option Base 1
Sub sirala_59()
Dim list(), i As Long, j As Long, k As Byte, deg
Dim deg1 As String, deg2 As String, x As Variant
Sheets("Sayfa1").Select
If Cells(65536, "B").End(xlUp).Row < 2 Then Exit Sub
list = Range("B2:D" & Cells(65536, "B").End(xlUp).Row).Value
For i = 1 To UBound(list, 1) - 1
    deg = Split(list(i, 1), " ")
    deg1 = deg(2)
    For j = i + 1 To UBound(list, 1)
        deg = Split(list(j, 1), " ")
        deg2 = deg(2)
        If StrComp(deg1, deg2, vbTextCompare) > 0 Then
            For k = 1 To 3
                x = list(i, k)
                list(i, k) = list(j, k)
                list(j, k) = x
            Next k
        End If
    Next j
Next i
Application.ScreenUpdating = False
Range("B2:D" & Cells(65536, "B").End(xlUp).Row).ClearContents
Range("B2").Resize(UBound(list, 1), 3) = list
Erase list
Application.ScreenUpdating = True
MsgBox "Sıralama yapıldı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[yakup123]

evren hocam çok çok teşekkür ederim sagolun