sıralama makrosu

[Hacı Bayram ÖZKAN]

Halit bey, sizin hazırlamış olduğunuz ekli dosyadaki rütbe adlı makrosu siz hazırladınız, burada sadece C sütununda sıralama yapıyor, oysaki ben bunu başka dosyalarımda da kullanmak istiyorum, neresini değiştireceğim, örneğin bu rütbeler B sütunu veya F sütununda olabilir, buna bir bakabilirmisin. teşekkürler.

 

[halit3]

kodların içindeki 3 ile 9 sayılarını değiştireceksiniz. 3 sayısı C sütununu gösteriyor.9 sayısı I sütununu gösteriyor. I sutunu yardımcı olarak kullanılmıştı biliyorsunuz.

Sub RÜTBE()
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
sonsat = Cells(Rows.Count, "C").End(3).Row
Rows(2 & ":" & sonsat).Select
TA = 3 'sutun
YA = 2 & ":" & sonsat
Rows(YA).Sort Key1:=Cells(TA), 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]

YANİ Kırmızı yazdığınız 3'leri 4 yaparsam d sütunundaki rütbelerimi süzecek, bunu yaptım olmadı yani BEN B sütunu ile H sütunu arasındaki D sütununa yazılı olan rütbeleri sıralamak istiyorum. 3'leri 4 yaptım olmadı

 

[halit3]

YANİ Kırmızı yazdığınız 3'leri 4 yaparsam d sütunundaki rütbelerimi süzecek, bunu yaptım olmadı yani BEN B sütunu ile H sütunu arasındaki D sütununa yazılı olan rütbeleri sıralamak istiyorum. 3'leri 4 yaptım olmadı

bunu denermisiniz.

Sub sırala2()
kolon = "D"
yard = "I"
For i = 2 To Cells(Rows.Count, kolon).End(3).Row
If Cells(i, kolon).Value = "3. Sınıf Emniyet Müdürü" Then Cells(i, yard).Value = Cells(i, kolon).Value: Cells(i, kolon).Value = 1
If Cells(i, kolon).Value = "4. Sınıf Emniyet Müdürü" Then Cells(i, yard).Value = Cells(i, kolon).Value: Cells(i, kolon).Value = 2
If Cells(i, kolon).Value = "Emniyet Amiri" Then Cells(i, yard).Value = Cells(i, kolon).Value: Cells(i, kolon).Value = 3
If Cells(i, kolon).Value = "Başkomiser" Then Cells(i, yard).Value = Cells(i, kolon).Value: Cells(i, kolon).Value = 4
If Cells(i, kolon).Value = "Komiser" Then Cells(i, yard).Value = Cells(i, kolon).Value: Cells(i, kolon).Value = 5
If Cells(i, kolon).Value = "Komiser Yardımcısı" Then Cells(i, yard).Value = Cells(i, kolon).Value: Cells(i, kolon).Value = 6
If Cells(i, kolon).Value = "Polis Memuru" Then Cells(i, yard).Value = Cells(i, kolon).Value: Cells(i, kolon).Value = 7
If Cells(i, kolon).Value = "Bekçi" Then Cells(i, yard).Value = Cells(i, kolon).Value: Cells(i, kolon).Value = 8
If Cells(i, kolon).Value = "Teknisyen Yrd." Then Cells(i, yard).Value = Cells(i, kolon).Value: Cells(i, kolon).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, [COLOR=red]1[/COLOR]), Cells(sat, sut)).Sort Key1:=Cells(2, kolon), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
For i = 2 To Cells(Rows.Count, kolon).End(3).Row
If Cells(i, yard).Value <> "" Then
Cells(i, kolon).Value = Cells(i, yard).Value
Cells(i, yard).Value = ""
End If
Next
End Sub

 

[Hacı Bayram ÖZKAN]

eline sağlık abi tamam olmuş, halit bey burda A kolonu sıralamaya dahil olmasa nasıl olur, sıra numarası bozuluyor onun için, eline sağlık

 

[halit3]

eline sağlık abi tamam olmuş, halit bey burda A kolonu sıralamaya dahil olmasa nasıl olur, sıra numarası bozuluyor onun için, eline sağlık

yukarıdaki mesajdaki kırmızı yerin sütun değerini değiştirerek yapabilirsiniz.

 

[Hacı Bayram ÖZKAN]

halit abi teşekkürler kusura bakmayın bazen sizleri bıktıra biliyoruz. Hakkınızı helal edin,

 

[halit3]

halit abi teşekkürler kusura bakmayın bazen sizleri bıktıra biliyoruz. Hakkınızı helal edin,

iyi çalışmalar