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

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,790
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
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?
 

Ekli dosyalar

Son düzenleme:

leumruk

Uzman
Uzman
Katılım
15 Nisan 2007
Mesajlar
3,469
Excel Vers. ve Dili
Office 2010 & 2013 tr
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.
Kod:
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
 

Ekli dosyalar

leumruk

Uzman
Uzman
Katılım
15 Nisan 2007
Mesajlar
3,469
Excel Vers. ve Dili
Office 2010 & 2013 tr
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.
Kod:
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
 

Ekli dosyalar

Son düzenleme:

assenucler

Altın Üye
Katılım
19 Ağustos 2004
Mesajlar
3,519
Excel Vers. ve Dili
Ofis 365 TR 64 Windows 11 Home Single Language x64 TR
Teşekkürler Sayın Leumruk.
 

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,790
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
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/
 
Son düzenleme:

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,790
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
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.

Kod:
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

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,790
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Arkadaşlar çözüm bulamadım maalesef, konu günceldir.
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
13,002
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
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

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,790
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
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

Uzman
Katılım
8 Mart 2011
Mesajlar
13,002
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Tekrar merhaba.

Aşağıdaki gibi dener misiniz?
Rich (BB code):
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

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,790
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Sayın Ömer Bey, valla süper oldu. Ellerinize sağlık, Allah razı olsun.

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

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
13,002
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
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.
.
Rich (BB code):
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
 
Son düzenleme:

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,790
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Sayın Ömer Bey, evet böyle daha iyi oldu. Ellerinize sağlık, çok teşekkür ediyorum.
 

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,790
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
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

Uzman
Katılım
8 Mart 2011
Mesajlar
13,002
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Şu an bilgisayar başında değilim.
Uygun olduğumda bakarım.
.
 

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,790
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Sağ olun Sayın Ömer Bey.
 

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,790
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
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.
 

Ekli dosyalar

Son düzenleme:
Üst