Rütbe Ve Sicile Göre Sıralama Yapmak

Rütbe Ve Sicile Göre Sıralama Yapmak - Baskı Önizleme

+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Rütbe Ve Sicile Göre Sıralama Yapmak (/konu-rutbe-ve-sicile-gore-siralama-yapmak.html)

Sayfalar: 1 2

Rütbe Ve Sicile Göre Sıralama Yapmak - hayalibey - 15/01/2020

Herkese Merhaba;
Ekte bir Excel ekledim. Burada VERİ sayfasında sicil rütbe ve bürolar var.
VERİ sayfasında iki tane düğme yaptım Rütbe Sicil Sıralama - --- Büroya Göre Sıralama şeklinde

Benim isteğim
1. İşlem : Rütbe ve Sicil Sıralamaya tıklayınca A sütunundaki sıralama hariç olmak üzere B2 - N2 aralığında excelin sonuna kadar önce rütbeye göre sıraya koyacak ( rütbeler aynı ise aynı rütbe içinde sicili küçük olanı ilk sıraya koyacak.) daha sonra sicili küçük olandan sıraya koyacak
Bu yüzden rütbeler elle yazılmasın diye KONTROL sayfasında sırası ile rütbeleri yazdım. Sıralama aynen öyle olacak

2. İşlem : Önce Bürolara göre sıralama yapacak sonra aynı büro içerinde rütbe ,( aynı büro içerisinde rütbeler aynı ise aynı rütbe içinde sicili küçük olanı ilk sıraya koyacak.) daha sonra sicili küçük olandan sıraya koyacak şekilde iki makroya ihtiyacım var. Elimde bir makro var ama revize edemedim. Yardımcı olur diye eklemek istiyorum.
Bu kodları user form aracılı ile de kullanmak istiyorum böylece userformda her yeni kayıtta sıralama yapmayı düşünüyorum.

Sub RUTBEYE_GORE_SIRALA()

Application.ScreenUpdating = False

Application.Calculation = xlCalculationAutomatic '    bu satır sonradan eklendi

Set s1 = Sheets("Sayfa1")

sonsat = s1.Cells(Rows.Count, 1).End(3).Row

If sonsat = 1 Then Exit Sub

    s1.Columns("R:R").Insert Shift:=xlToRight

    ActiveWorkbook.Names.Add Name:="rutbe", RefersTo:="=Sayfa2!$Z$2:$Z$17"

    s1.[R2].Formula = "=MATCH(G2,rutbe,0)"

    s1.[R2].AutoFill Destination:=s1.Range("R2:R" & sonsat)

    s1.Range("A2:Z" & sonsat).Sort Key1:=s1.[E2], Order1:=1, Key2:=s1.[R2], Order2:=1, Key3:=s1.[C2], ORder3:=1

    Columns("R:R").Delete Shift:=xlToLeft

Application.ScreenUpdating = True

MsgBox "RÜTBEye göre sıralama yapıldı."

End Sub

Cvp: Rütbe Ve Sicile Göre Sıralama Yapmak - feraz - 16/01/2020

Merhaba.
Makro kaydet ile resimdeki gibi istediğiniz sıralamaları yaptırabilirsiniz.

Cvp: Rütbe Ve Sicile Göre Sıralama Yapmak - feraz - 16/01/2020

Mesela bende böyle kod oluştu Makro kaydet ile.
Daha sonra ilgili yerleri kısaltılıp değiştirilebilinir.

Sub Makro1()

'

' Makro Makro1

'



'

    ActiveWorkbook.Worksheets("VERİ").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("VERİ").Sort.SortFields.Add2 Key:=Range("B2:B99"), _

        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    ActiveWorkbook.Worksheets("VERİ").Sort.SortFields.Add2 Key:=Range("C2:C99"), _

        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    ActiveWorkbook.Worksheets("VERİ").Sort.SortFields.Add2 Key:=Range("D299"), _

        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    ActiveWorkbook.Worksheets("VERİ").Sort.SortFields.Add2 Key:=Range("E2:E99"), _

        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("VERİ").Sort

        .SetRange Range("A1:N99")

        .Header = xlYes

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

End Sub

Cvp: Rütbe Ve Sicile Göre Sıralama Yapmak - feraz - 16/01/2020

Örnek Makro kaydetme ve Özel sıralama.

Cvp: Rütbe Ve Sicile Göre Sıralama Yapmak - feraz - 16/01/2020

......

Cvp: Rütbe Ve Sicile Göre Sıralama Yapmak - hayalibey - 16/01/2020

(16/01/2020, 16:45)feraz yazdı: ......

Rütbeler a dan z. Ye siralanmayacak ki benim istediğim sıra ile olmak zorunda sayin Feraz