• Merhaba Ziyaretçi,
    Microsoft 365 Uygulamaları ile ilgili yeni haberler, dikkat çekici konular, ilgi ile takip edeceğiniz yazılar için.

    Abone Olun
  • ESTE - Microsoft Office Eğitimleri

    Yeni yıl Microsoft Office Eğitim planlarınız için bütçenizi oluşturmadan önce ESTE eğitim kalitesi ile tanışın. 🙌
    Kullanıcıların ihtiyacı olan yazılı materyal, dosya ve video kaynağı desteğimiz ile tüm ofis çalışanlarının iş süreçlerini rahatlatacak eğitimler planlayın. 🎯
    Microsoft Office eğitimlerimiz hakkında detaylı bilgi için bize ulaşın.

    👉 Microsoft Office Eğitim Talebi

Çözüldü Rütbeye ve Sicile Göre Sıralama Yapmak

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...

hayalibey

Yeni Üye
Katılım
5 Nis 2019
Mesajlar
18
En iyi yanıt
0
Puanları
1
Yaş
41
Konum
Ankara
Ad Soyad
Mahmut YILDIZ
Office Vers.
Ofis 2016 TR 64 Bit
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.


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

Ekli dosyalar

  • Rütbe ve sicile Göre Sıralama.xlsm
    30.6 KB · Görüntüleme: 9

hayalibey

Yeni Üye
Katılım
5 Nis 2019
Mesajlar
18
En iyi yanıt
0
Puanları
1
Yaş
41
Konum
Ankara
Ad Soyad
Mahmut YILDIZ
Office Vers.
Ofis 2016 TR 64 Bit
Sorun çözülmüştür.
Kod:
Option Explicit
Sub Rutbe_Sicil_Sirala()
    Dim VeriSyf, SonSat
    Set VeriSyf = Sheets("VERİ")
    SonSat = VeriSyf.Cells(Rows.Count, 2).End(3).Row
    If SonSat < 3 Then Exit Sub
    Application.ScreenUpdating = False
    VeriSyf.Range("A2", "A" & SonSat).FormulaR1C1 = "=MATCH(RC[4],KONTROL!C[1],0)"
    VeriSyf.Range("A2", "A" & SonSat).Value = VeriSyf.Range("A2", "A" & SonSat).Value
    VeriSyf.Range("A2:N" & SonSat).Sort Key1:=VeriSyf.[A2], Order1:=xlAscending, Key2:=VeriSyf.[B2], ORder2:=xlAscending
    VeriSyf.Range("A2").Value = "1"
    VeriSyf.Range("A2", "A" & SonSat).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
    Application.ScreenUpdating = True
End Sub

Sub Buro_Sirala()
    Dim VeriSyf, SonSat
    Set VeriSyf = Sheets("VERİ")
    SonSat = VeriSyf.Cells(Rows.Count, 2).End(3).Row
    If SonSat < 3 Then Exit Sub
    Rutbe_Sicil_Sirala
    Application.ScreenUpdating = False
    VeriSyf.Range("A2", "A" & SonSat).FormulaR1C1 = "=MATCH(RC[5],KONTROL!C,0)"
    VeriSyf.Range("A2", "A" & SonSat).Value = VeriSyf.Range("A2", "A" & SonSat).Value
    VeriSyf.Range("A2:N" & SonSat).Sort Key1:=VeriSyf.[A2], Order1:=xlAscending
    VeriSyf.Range("A2").Value = "1"
    VeriSyf.Range("A2", "A" & SonSat).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
    Application.ScreenUpdating = True
End Sub

Sub Isim_A_Z_sirala()
    Dim VeriSyf, SonSat
    Set VeriSyf = Sheets("VERİ")
    SonSat = VeriSyf.Cells(Rows.Count, 2).End(3).Row
    If SonSat < 3 Then Exit Sub
    Application.ScreenUpdating = False
    VeriSyf.Range("B2:N" & SonSat).Sort Key1:=VeriSyf.[C2], Order1:=xlAscending
    Application.ScreenUpdating = True
End Sub

Sub Isim_Z_A_sirala()
    Dim VeriSyf, SonSat
    Set VeriSyf = Sheets("VERİ")
    SonSat = VeriSyf.Cells(Rows.Count, 2).End(3).Row
    If SonSat < 3 Then Exit Sub
    Application.ScreenUpdating = False
    VeriSyf.Range("B2:N" & SonSat).Sort Key1:=VeriSyf.[C2], Order1:=xlDescending
    Application.ScreenUpdating = True
End Sub
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Üst Alt