sıralama makrosu

[Hacı Bayram ÖZKAN]

arkadaşlar ekli dosyama göre makro ile sıralama yaptırmak istiyorum, nasıl yapılır. Teşekkür ediyorum.

 

[rahmi06]

Dosyanız Ekte.

 

[Hacı Bayram ÖZKAN]

Rütbeye göre sıralama yapmadı.

 

[rahmi06]

Rütbeye göre sıralama yapmadı.

Sıralama yapmadıysa özür dilerim kusura bakmayın.
RÜTBE SİCİLE GÖRE SIRALA tuşuna basmayı denedinizmi?
Bastıysanız RÜTBESİ altındaki bilgilerin buna göre AZ sıralandığını görmedinizmi?

 

[halit3]

alternatif kod
istediğiniz 3 sütuna göre sıralama

Sub sırala()
On Error Resume Next
sat = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
sut = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(sat, sut)).Select
Application.Dialogs(39).Show
Range("a1").Select
End Sub

 

[Hacı Bayram ÖZKAN]

Halit bey sizin yazdığınız ve rahmi beyin yazmış olduğu kodda rütbeye göre alfabetik sıralıyor, oysa benim isteğim, bakın ekli dosyanın rütbenin yüksekten düşüğe J sütununda sıralanışını yazdım.
Yani rütbeye göre sırala deyince 4. Sınıf Emniyet Müdürü 1. sırada daha sonra Emniyet Amiri, Başkomiser, Komiser, Komiser Yardımcısı, Polis Memuru Bekçi şeklinde sıralaması lazım, görünüşte sıralı gibi, bence burda her rütbeyi tanımlamak lazım. Bunu yapamadım. dosya ekte

 

[halit3]

ı sütunu yardımcı olarak kullanılmıştır
bu sıralama yanlızca rütbeye göre saıralamaktadır.

Sub sırala2()
For i = 2 To Cells(Rows.Count, "C").End(3).Row
If Cells(i, 3).Value = "3. Sınıf Emniyet Müdürü" Then Cells(i, 9).Value = Cells(i, 3).Value: Cells(i, 3).Value = 1
If Cells(i, 3).Value = "4. Sınıf Emniyet Müdürü" Then Cells(i, 9).Value = Cells(i, 3).Value: Cells(i, 3).Value = 2
If Cells(i, 3).Value = "Emniyet Amiri" Then Cells(i, 9).Value = Cells(i, 3).Value: Cells(i, 3).Value = 3
If Cells(i, 3).Value = "Başkomiser" Then Cells(i, 9).Value = Cells(i, 3).Value: Cells(i, 3).Value = 4
If Cells(i, 3).Value = "Komiser" Then Cells(i, 9).Value = Cells(i, 3).Value: Cells(i, 3).Value = 5
If Cells(i, 3).Value = "Komiser Yardımcısı" Then Cells(i, 9).Value = Cells(i, 3).Value: Cells(i, 3).Value = 6
If Cells(i, 3).Value = "Polis Memuru" Then Cells(i, 9).Value = Cells(i, 3).Value: Cells(i, 3).Value = 7
If Cells(i, 3).Value = "Bekçi" Then Cells(i, 9).Value = Cells(i, 3).Value: Cells(i, 3).Value = 8
If Cells(i, 3).Value = "Teknisyen Yrd." Then Cells(i, 9).Value = Cells(i, 3).Value: Cells(i, 3).Value = 9
Next
On Error Resume Next
sat = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
sut = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Cells(2, 1), Cells(sat, sut)).Sort Key1:=Range("c2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
For i = 2 To Cells(Rows.Count, "C").End(3).Row
Cells(i, 3).Value = Cells(i, 9).Value
Cells(i, 9).Value = ""
Next
End Sub

 

[Hacı Bayram ÖZKAN]

ABİ eline sağlık

 

[halit3]

7 nolu mesajdaki kodu yeniden düzenledim.

iyi çalışmalar