Büyükten Küçüğe Sıralama (MAKRO İLE)

[sirkülasyon]

H30:H41 arasında isimler mevcut
N30:N41 arasında da rakamlar mevcut

O30:O41 aralığına İsimleri
Q30:Q41ralığına da rakamları büyükten küçüğe doğru isimler alfabetik olarak sıralama yapacak bir makroya ihtiyacım var.

Yardımcı olabilir misiniz?

 

[YUSUF44]

Makro kaydet yöntemiyle kendiniz yapabilirsiniz.

Benim makro kaydet ile elde ettiğim kodlar şu şekilde:

Sub Makro4()
'
' Makro4 Makro
'

'
    Range("O30:Q41").Select
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("O30:O41") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveSheet.Sort.SortFields.Add Key:=Range("Q30:Q41") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("O30:Q41")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 

[sirkülasyon]

Yusuf Abi
Herhalde yanlış anlattım.
H30:H41 aralığında isim ve bu isimlere ait N30:N41 aralığında da rakamlar mevcut.


N30:N41 aralığında ki rakamı büyükten küçüğe doğru Q30:Q41 aralığına
H30:H41 aralığında ki isimleri de O30:O41 aralığına aktarmak istiyorum.

Aynı sütunda değil

 

[YUSUF44]

Aynı şekilde makro kaydet yoluyla elde ettiğim kodlar aşağıdaki gibidir:

Sub Makro5()
'
' Makro5 Makro
'

'
    Range("H30:H41").Select
    Selection.Copy
    Range("O30").Select
    ActiveSheet.Paste
    Range("N30:N41").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("Q30").Select
    ActiveSheet.Paste
    Range("O30:Q41").Select
    Application.CutCopyMode = False
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("O30:O41") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveSheet.Sort.SortFields.Add Key:=Range("Q30:Q41") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("O30:Q41")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Mantık: Kopyala/Yapıştır/Sırala

 

[YUSUF44]

isimler kendi arasında, sayılar kendi arasıdna ayrı ayrı sıralansın yani birbirine bağlı olmasın istiyorsanız ise aşağıdaki kodlar oluşuyor:

Sub Makro7()
'
' Makro7 Makro
'

'
    Range("H30:H41").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("O30").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("O30"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("O30:O41")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("N30:N41").Select
    Selection.Copy
    Range("Q30").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("Q30"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("Q30:Q41")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Tüm kodlarda yaptığım tek değişiklik sizin dosyanıza uyum sağlasın diye ActiveWorkbook.Worksheets("Sayfa2"). olan kısımları ActiveSheet. olarak değiştirdim.

 

[sirkülasyon]

Yusuf Abi
Rakam sıralamasında sıkıntı yok. O kısmı MAKRO KAYDET ile yapıyorum.
Sıkıntı okul sıralamasında
Rakama ait okulu getiremiyorum.
Ekli dosya da olması gereken şekilde yan sütuna yazdım

 

[YUSUF44]

4. mesajımdaki kodda ufak bir değişiklik yaptım, sıralamanın sırasını önce rakamlar sonra okullar olarak değiştirdim(mavi ve kırmızı yerleri yer değiştirdim):

Sub Makro5()
'
' Makro5 Makro
'

'
    Range("H30:H41").Select
    Selection.Copy
    Range("O30").Select
    ActiveSheet.Paste
    Range("N30:N41").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("Q30").Select
    ActiveSheet.Paste
    Range("O30:Q41").Select
    Application.CutCopyMode = False
    ActiveSheet.Sort.SortFields.Clear
[COLOR="Red"]    ActiveSheet.Sort.SortFields.Add Key:=Range("Q30:Q41") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal[/COLOR]
[COLOR="Blue"]    ActiveSheet.Sort.SortFields.Add Key:=Range("O30:O41") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal[/COLOR]
    With ActiveSheet.Sort
        .SetRange Range("O30:Q41")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 

[YUSUF44]

Tekrar belirteyim bunu makro kaydet yoluyla siz de çok kolay bir şekilde yapabilirsiniz. Çünkü yaptığımız sadece kopyalama, yapıştırma ve sıralama.

 

[sirkülasyon]

Yusuf Abim
Allah ne muradın varsa versin.
Size verdiğim zahmetler için, rahatsızlıklar için Hakkınızı helal edin.
Teşekkür eder saygılarımı sunarım

 

[BBBBuRaKKKK]

Merhabalar Yusuf Bey

-Bu makro şuanda bütün sütunları kendi içinde küçükten büyüğe doğru sıralıyor.
-B sütununa göre diğer sütunları sıralayabilirmiyiz satırlar bozulmadan ?

Teşekkür ederim şimdiden

 

[Zigana61]

Merhabalar benim sipariş tarihlerim var bu tarihleri en erkenden en geç olacak şekilde sıralamak istiyorum aynı zamanda da sipariş tarihlerimle siparişlerim var bunlarda küçükten büyüğe doğru sıralanmasını istiyorum bunu makro kaydet dışında nasıl yapabilirim