İstenilen rütbe sınıfına göre sıralama

[ASLAN7410]

Merhaba hayırlı sabahlar.

Ekte gönderdiğim excel dosyamın D sütununda çeşitli rütbe sınıfı bulunmaktadır.

Yapmak istediğim bunları istediğim sınıfa göre sıralamak istiyorum.
Alfabetik sıralama yapmak istemiyorum. A'dan Z'ye yada Z'den A'ya sıralamak istemiyorum.

Örneğin sıralama Teknisyen, Çaycı, Şoför ve Temizlikçi şeklinde sıralamak istiyorum.
Yani özel sıralama yapmak istiyorum.
Bu şekilde bir çalışma yapılabilir mi?

Forumda ve internette böyle bir çalışma bulamadım.

Yardımcı olur musunuz?

 

[leumruk]

Selamlar,
Bunun için farklı yollar denenebilir. Excel'in "Hücre rengine göre sıralama" özelliğinden yola çıkarak bir kodlama geliştirdim. Sayfa2'de istediğiniz sıralama düzenini oluşturarak deneyiniz.

Sub SeciliSiralama()
Set syf1 = Sheets("Sayfa1")
Set syf2 = Sheets("Sayfa2")
Sonsat1 = syf1.Cells(syf1.Rows.Count, 3).End(3).Row
SonSat2 = syf2.Cells(syf2.Rows.Count, 2).End(3).Row
Set Aralik = syf1.Range("D2:D" & Sonsat1)
syf1.Sort.SortFields.Clear
Aralik.Interior.Pattern = xlNone
For x = 1 To SonSat2
'----------------
    With Application.ReplaceFormat.Interior
        .PatternColorIndex = xlAutomatic
        .Color = syf2.Cells(x, 3).Interior.Color
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Aralik.Replace What:=syf2.Cells(x, 2), Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=True
'----------------
R = colorRGB(syf2.Cells(x, 3), 1)
G = colorRGB(syf2.Cells(x, 3), 2)
B = colorRGB(syf2.Cells(x, 3), 3)
   syf1.Sort.SortFields.Add(Aralik, 1, 1, , 0).SortOnValue.Color = RGB(R, G, B)
Next
    With syf1.Sort
        .SetRange syf1.Range("B1:E" & Sonsat1)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Aralik.Interior.Pattern = xlNone

MsgBox "Sıralama tamamlandı.", vbOKOnly, "l e u m r u k"
End Sub

 

[leumruk]

Selamlar,
Deneme yaparken excelin daha önce benim bilmediğim bir sıralama özelliğini keşfettim. Bir önceki kodla işi oldukça uzatmışım. İçerisinde değişik kod örnekleri bulunduğu için onu silmiyorum. Alternatif olarak bunu deneyiniz.
Makrosuz yapmak isterseniz: Sıralamak istediğiniz alanı başlık satırıyla birlikte seçin. Sağ tıklayıp "Sırala" sekmesinden "Özel" seçeneğini seçin. "Ölçüt" için "Rütbe" sütununu; "Koşul" için "Değerler"'i "Düzen" için "Özel Liste"yi seçin.
Ardından aralarına virgül koyarak sırayla rütbeleri yazın, sonrasında "Ekle"yi tıklayın ve "Tamam"ı tıklatın.

Bunu makro olarak çalıştırmak isterseniz örneği inceleyin. Kod içerisindeki Rütbe adlarını kendinize uyarlayabilirsiniz.

Sub Sirala()
    ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Add Key:=Range("D2:D20") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "Temizlikçi,Şoför,Çaycı,Teknisyen", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sayfa1").Sort
        .SetRange Range("B1:E20")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 

[assenucler]

Teşekkürler Sayın Leumruk.

 

[leumruk]

Teşekkürler Sayın Leumruk.

Rica ederim.

 

[ASLAN7410]

Sayın leumruk, ilginiz ve çözümleriniz için çok teşekkür ediyorum, ellerinize sağlık, süper bir çalışma olmuş.
Dün bu işlem için bayağı uğraştım, çok zaman sonrada forumda aşağıdaki linkte böyle bir çalışmada buldum.

Belki birilerinin işine yarar diye linki ekliyorum.

Hayırlı çalışmalar diliyorum.

https://www.excel.web.tr/threads/oezel-siralama.106138/

 

[leumruk]

Rica ederim.

 

[ASLAN7410]

Tekrar merhaba arkadaşlar.

https://www.excel.web.tr/threads/oezel-siralama.106138/ bu linkteki 7.mesajda destek ekibinden Emir Hüseyin ÇOBAN'ın eklemiş olduğu örnek dosyada aşağıdaki kod var, ben bu kodu kendi sayfama uyarlıyarak 3.şart ekledim ancak çalışmıyor.
Ekte gönderdiğim excel sayfasındaki kodlardan BüroyaGöreSırala kodu var bu kod çalışıyor ama rütbe sırasına sokmuyor.
Ben rütbe sırasına göre sıralamak istiyorum. Kod yazmayı beceremediğim için aşağıdaki kod bana daha basit geldi, yardımcı olur musunuz?
Rütbe sırası aşağıdaki gibi olması gerekiyor.

Sub ÖzelSırala()
Application.AddCustomList ListArray:=Array( _
        "1.Sınıf Emniyet Müdürü", _
        "2.Sınıf Emniyet Müdürü", _
        "3.Sınıf Emniyet Müdürü", _
        "4.Sınıf Emniyet Müdürü", _
        "Emniyet Amiri", _
        "Başkomiser", _
        "Komiser", _
        "Komiser Yardımcısı", _
        "Kıdemli Başpolis Memuru", _
        "Başpolis Memuru", _
        "Polis Memuru", _
        "GİH Memuru", _
        "Bekçi", _
        "Teknisyen Yardımcısı", _
        "Hayvan Bakıcısı")

    Range("C2:QM65536").Sort _
    Key1:=Range("E2"), Order1:=xlAscending, _
    Key2:=Range("G2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=7, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal, _
    Key3:=Range("C2"), Order3:=xlAscending
MsgBox "Sayfada sıralama yapıldı!", vbInformation, "A S L A N"
Range("A2").Select
End Sub

 

[ASLAN7410]

Arkadaşlar çözüm bulamadım maalesef, konu günceldir.

 

[Ömer BARAN]

Merhaba.

Hemen cevap verecektim ama birkaç şey sorayım:
-- E sütununun önceliği nedir? (özel liste ile ilgili olarak verilmiş sayılar mıdır?)
-- E sütunu kullanılmadan, önce G sütunu (eklenen özel listeye göre), G sütunu eşdeğer olanlar da kendi arasında C sütunundaki sicil numarasına göre sıralanırsa hatalı mı olur?
-- Sıralamanın öncelik sırasını sütun adlarını belirterek yazar mısınız? (önce G, sonra E, sonra da C sütunu gibi)
.

 

[ASLAN7410]

Sayın Ömer Bey, ilginiz için çok teşekkür ediyorum, hayırlı geceler.

İstenilen büroların öncelik sırasına göre önce E sütununda sıralama oluyor, sonra her büroya göre G sütununda rütbeliler sıralanıyor, daha sonra bu rütbeliler de bürolara göre C sütununda sicil sırasına göre sıralama oluyor. Bu şekilde yapmaya çalışıyorum.
Önce E sütunu, sonra G sütunu ve C sütunu şeklinde olacak.

 

[Ömer BARAN]

Tekrar merhaba.

Aşağıdaki gibi dener misiniz?

Sub SIRALAMA_BARAN()
    sonsat = Cells(Rows.Count, 1).End(3).Row
    ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Clear
    With ActiveWorkbook.Worksheets("Sayfa1").Sort
        .SortFields.Add Key:=Range("E2:E" & sonsat), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("G2:G" & sonsat), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
            "1.Sınıf Emniyet Müdürü,2.Sınıf Emniyet Müdürü,3.Sınıf Emniyet Müdürü,4.Sınıf Emniyet Müdürü,Emniyet Amiri,Başkomiser,Komiser,Komiser Yardımcısı,Kıdemli Başpolis Memuru,Başpolis Memuru,Polis Memuru,GİH Memuru,Bekçi,Teknisyen Yardımcısı,Hayvan Bakıcısı" _
            , DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("C2:C" & sonsat), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("C2:Z" & sonsat): .Header = xlNo: .Apply
    End With
End Sub

 

[ASLAN7410]

Sayın Ömer Bey, valla süper oldu. Ellerinize sağlık, Allah razı olsun.

Hayırlı geceler, hayırlı cumalar diliyorum.

 

[Ömer BARAN]

Böyle daha kısa oldu.
Artan/azalan tercihini, kırmızı 1'leri (xlAscending anlamında), 2 (xlDescending anlamında) yaparak değiştirebilirsiniz.
.

Sub SIRALAMA_BARAN()
    sonsat = Cells(Rows.Count, 1).End(3).Row
    ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Clear
    With ActiveWorkbook.Worksheets("Sayfa1").Sort
        .SortFields.Add Key:=Range("E2:E" & sonsat), Order:=1
        .SortFields.Add Key:=Range("G2:G" & sonsat), Order:=1, CustomOrder:= _
            "1.Sınıf Emniyet Müdürü,2.Sınıf Emniyet Müdürü,3.Sınıf Emniyet Müdürü,4.Sınıf Emniyet Müdürü,Emniyet Amiri,Başkomiser,Komiser,Komiser Yardımcısı,Kıdemli Başpolis Memuru,Başpolis Memuru,Polis Memuru,GİH Memuru,Bekçi,Teknisyen Yardımcısı,Hayvan Bakıcısı"
        .SortFields.Add Key:=Range("C2:C" & sonsat), Order:=1
        .SetRange Range("C2:Z" & sonsat): .Apply
    End With
    ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Clear
End Sub

 

[ASLAN7410]

Sayın Ömer Bey, evet böyle daha iyi oldu. Ellerinize sağlık, çok teşekkür ediyorum.

 

[Ömer BARAN]

Kolay gelsin, iyi çalışmalar dilerim.
.

 

[ASLAN7410]

Sayın Ömer Bey hayırlı akşamlar, tekrar rahatsız ediyorum kusura bakmayın.

12.mesajınızdaki kod gayet güzel çalışıyor, çokta işime yaradı, çok teşekkür ediyorum.

Rütbeleri Sayfa2 Z sütunundaki rütbeleri alarak işlem yapsa, bu şekilde düzenleyebilir misiniz?

 

[Ömer BARAN]

Şu an bilgisayar başında değilim.
Uygun olduğumda bakarım.
.

 

[ASLAN7410]

Sağ olun Sayın Ömer Bey.

 

[ASLAN7410]

Sayın Ömer Bey, sayfada sıralama yapıp sayfayı kaydederek kapattığımda aşağıdaki gibi hatalar alıyorum.
Dosyayı açtığımda ilk resim geliyor Evet dediğimde, 2.resim geliyor, buradaki linke tıkladığımda 3.resim ekrana geliyor, 4.resimde sayfanın onarılmış bir sayfa olduğunu görüntülüyor.

Kodları orijinal dosyamda yaptığım bu şekilde sorunlar oluşuyor, bunun nedenini çözemedim.