Soru ŞARTA GÖRE SIRALAMA

[emre67z]

Merhaba,

Birim bazlı, mesleklerin son sütunda yer alan puanlarına göre yüksekten düşüğe göre sıralanmasını istiyoruz.

yardımcı olacak olan arkadaşlara şimdiden çok teşekkür ederim,
1500-1700 satırlık bir çalışma ilk 39 satırı ben kopyaladım. Her unvanı karışığındaki puana göre yüksekten düşüğe göre sıralanmasını istiyoruz.

Saygılarımla.

 

[Muzaffer Ali]

Merhaba.
Bir modüle kopyalayıp çalıştırın.

Sub Test()
    Dim Bak As Long
    Dim IlkSatir As Long
    IlkSatir = 2
    Application.ScreenUpdating = False
    With ThisWorkbook.Worksheets("LİSTE")
        For Bak = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
            If .Cells(Bak - 1, "A") = "" And .Cells(Bak, "A") <> "" Then
                IlkSatir = Bak
            End If
            If .Cells(Bak + 1, "A") = "" And .Cells(Bak, "A") <> "" Then
                .Sort.SortFields.Clear
                .Sort.SortFields.Add2 Key:=.Range("G" & IlkSatir & ":G" & Bak), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                With .Sort
                    .SetRange Range("A" & IlkSatir & ":G" & Bak)
                    .Header = xlGuess
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            End If
        Next
    End With
    Application.ScreenUpdating = True
    MsgBox "İşlem tamamlandı", vbInformation, "Alfabetik Sırala"
End Sub

 

[1Al2Ver]

Merhaba,

Sayın Muzaffer Ali'nin affına sığınarak,

Yaptığım denemeler sonucu,

"Liste" sayfası "G" sütununda, Büyükten Küçüğe sıralama için, kod'da yer alan Order:=xlAscending komutunu, Order:=xlDescending, şeklinde düzeltince sonuç elde ettim.

Teşekkür ederim.

 

[Muzaffer Ali]

Orayı kaçırmışım. Küçükten büyüğe sıralama yapmışım.

Büyükten küçüğe sıralamak için Order:=xlAscending yerine Order:=xlDescending olmalı.

 

[emre67z]

Merhaba.
Bir modüle kopyalayıp çalıştırın.

Sub Test()
    Dim Bak As Long
    Dim IlkSatir As Long
    IlkSatir = 2
    Application.ScreenUpdating = False
    With ThisWorkbook.Worksheets("LİSTE")
        For Bak = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
            If .Cells(Bak - 1, "A") = "" And .Cells(Bak, "A") <> "" Then
                IlkSatir = Bak
            End If
            If .Cells(Bak + 1, "A") = "" And .Cells(Bak, "A") <> "" Then
                .Sort.SortFields.Clear
                .Sort.SortFields.Add2 Key:=.Range("G" & IlkSatir & ":G" & Bak), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                With .Sort
                    .SetRange Range("A" & IlkSatir & ":G" & Bak)
                    .Header = xlGuess
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            End If
        Next
    End With
    Application.ScreenUpdating = True
    MsgBox "İşlem tamamlandı", vbInformation, "Alfabetik Sırala"
End Sub

Hocam merhaba,

With ThisWorkbook.Worksheets("LİSTE")
Kısmını liste değilde bulunan mevcut sayfada çalıştırılması için ne yazmam gerekli.

 

[Muzaffer Ali]

Şöyle olmalı.

With ThisWorkbook.activesheet

 

[emre67z]

çok teşekkür ederim.

 

[emre67z]

Muzaffer Ali bey, geçen yıl desteğiniz ile yaptığımız çalışmada. çok güzel sıralama işlemi gerçekleştiriyor. Ancak sıralama işlemini aradaki boşlukları baz alarak yapıyor. Boşluklar yerine
ÜNİTE VE MESLEK BAŞLIKLARINI baz alarak gerçekleştirebilir miyiz?