• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Sıralama

magnesia

Yasaklı üye
Katılım
1 Ocak 2018
Mesajlar
351
Excel Vers. ve Dili
Excel 2010 Türkçe
Arkadaşlar selam.
Eğitim planı hazırlıyorum.
İsteğim şu :
Sayfa aktif olduğunda; B:H arasını, C sütununu baz alarak, aylara göre sıralamasını istiyorum.
Ancak şöyle bir durum var.
Tabloda görüleceği üzere, C sütununun en başında ay ismi olmayan eğitim tarihleri var.
Ay ismi olmayanları, listenin en başına, alfabetik (A’dan-Z’ye), ay ismi olanları da normal ay sırasına göre (Ocak-Şubat-Mart…….) şeklinde sıralaması mümkün mü?
Şimdiden teşekkürler.
 

Ekli dosyalar

Merhaba elinizdeki verileri aynı sayfa içerisinde mi sıralandırmak mı istiyorsunuz ?
 
caneruysal arkadaşım.
Öncelikle ilginize teşekkür ederim.
Aynen çizelgede görüldüğü şekilde sıralamak istiyorum.
 
Merhaba,

Bu şekilde deneyin.

Kod:
Sub sort_test()
a = Range("B6:H" & Cells(Rows.Count, 2).End(3).Row).Value

ReDim b(1 To UBound(a))

    For i = 1 To UBound(a)
        deg = Format("1." & a(i, 2), "mm")
        If IsNumeric(deg) Then a(i, 2) = deg
        b(i) = Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4), a(i, 5), a(i, 6), a(i, 7))
    Next i

    For i = 1 To UBound(a)
        For j = i To UBound(a)
            If b(j)(1) < b(i)(1) Then
                krt = b(j)
                b(j) = b(i)
                b(i) = krt
            End If
        Next j
    Next i

ReDim c(1 To UBound(a), 1 To UBound(a, 2))

    For i = 1 To UBound(a)
        If Not IsNumeric(b(i)(1)) Then
            say = say + 1
            For j = 0 To UBound(a, 2) - 1
                c(say, j + 1) = b(i)(j)
            Next j
        End If
    Next i

    For i = 1 To UBound(a)
        If IsNumeric(b(i)(1)) Then
            say = say + 1
            For j = 0 To UBound(a, 2) - 1
                c(say, j + 1) = b(i)(j)
            Next j
            c(say, 2) = Format("1." & c(say, 2), "mmmm")
        End If
    Next i

[B6].Resize(say, UBound(a, 2)) = c

MsgBox "İşlem tamam.", vbInformation
End Sub
 
Tamamdır Ziynettin kardeşim.
Sabah dener, sonuçtan bilgi veririm.
İlgine, bilgine ve emeğine sağlık.
Çok teşekkür ederim.
 
Geri
Üst