İ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,128
Beğeniler
21
Excel Vers. ve Dili
Ofis 2013 Türkçe
#1
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:
Katılım
15 Nisan 2007
Mesajlar
3,388
Beğeniler
26
Excel Vers. ve Dili
Office 2010 & 2013 tr
#2
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

Katılım
15 Nisan 2007
Mesajlar
3,388
Beğeniler
26
Excel Vers. ve Dili
Office 2010 & 2013 tr
#3
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:

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,128
Beğeniler
21
Excel Vers. ve Dili
Ofis 2013 Türkçe
#6
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,128
Beğeniler
21
Excel Vers. ve Dili
Ofis 2013 Türkçe
#8
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,128
Beğeniler
21
Excel Vers. ve Dili
Ofis 2013 Türkçe
#9
Arkadaşlar çözüm bulamadım maalesef, konu günceldir.
 
Katılım
8 Mart 2011
Mesajlar
12,826
Beğeniler
604
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
#10
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,128
Beğeniler
21
Excel Vers. ve Dili
Ofis 2013 Türkçe
#11
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.
 
Katılım
8 Mart 2011
Mesajlar
12,826
Beğeniler
604
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
#12
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,128
Beğeniler
21
Excel Vers. ve Dili
Ofis 2013 Türkçe
#13
Sayın Ömer Bey, valla süper oldu. Ellerinize sağlık, Allah razı olsun.

Hayırlı geceler, hayırlı cumalar diliyorum.
 
Katılım
8 Mart 2011
Mesajlar
12,826
Beğeniler
604
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
#14
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,128
Beğeniler
21
Excel Vers. ve Dili
Ofis 2013 Türkçe
#15
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,128
Beğeniler
21
Excel Vers. ve Dili
Ofis 2013 Türkçe
#17
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?
 

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,128
Beğeniler
21
Excel Vers. ve Dili
Ofis 2013 Türkçe
#20
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