1. sorum Sayfaların isim ve rakam sırasına göre sıralama.

[Ahmet TUNALI]

Sub sirala()
For a = 1 To Sheets.Count
For b = a + 1 To Sheets.Count
If LCase(Sheets(b).Name) > LCase(Sheets(a).Name) Then GoTo 10
Sheets(b).Move before:=Sheets(a)
10 Next
Next
End Sub
Bu makroda sıralama isme göre yapılıyor.ancak sayfa isimleri rakam ile başlıyorsa sıralamayı 1m-2c-3d şeklinde değil 1m-12k şeklinde yapıyor.
bu makroda mantık 11-12-13-14-15-16-17-18-19-20 şeklinde sıralıyor.
Benim isteğim harf sıralaması gibi rakamlarda da 1-2-3 .... şeklnde sayfaları sıralasın.

 

[Korhan Ayhan]

Excel hücrelerine bir sütuna bahsettiğiniz sayfa isimlerinizi yazıp sıralamayı denediniz mi? Sonuç nasıl çıkıyor.

 

[Ahmet TUNALI]

Korhan bey,
Benim sayfalarım 1-Fatsa, 15-Samsun 2-Ankara, 18-Çorum çalıştırdığımda
sıralama 1-Fatsa, 15-Samsun,18-Çorum,2-Ankara şeklinde yapılıyor.
Benim istadiğim 1-Fatsa,2-Ankara,15-Samsun,18-Çorum şeklinde sıralansın.
ilginize teşekkürler.

 

[YUSUF44]

Başka çözüm bulunabilir mi bilmiyorum ama ya sayıları 01, 02 formatında yapmalısınız ya da sayılarla metinleri ayrı hücrelerde listeleyip, sıralamayı bu hücrelere göre yapıp, sonra da sayfaları bu sıralamaya göre olması gereken yere taşımalısınız. Eğer hücre kullanılmak istenmiyorsa kodda diziye çevrilip o dizide sıralama yapılabilir ama bunu nasıl yaparız bilmiyorum.

 

[veyselemre]

Sayfa isimlerini 01-Fatsa, 02-Ankara şeklinde oluşturursanız, yukarıdaki kodunuzla istediğiniz sıralamayı yapacaktır.

Bu kodla da 1-Fatsa formatındaki verilerinizi 01-Fatsa formatına çevirerek sıralar.

Sub sirala()

basla:
    For a = 1 To Sheets.Count - 1
        al1 = LCase(Sheets(a).Name)
        s = Split(al1, "-")
        If UBound(s) > 0 Then s(0) = Format(s(0), "00-")
        s1 = Join(s, "-")
        For b = a + 1 To Sheets.Count
            al1 = LCase(Sheets(b).Name)
            s = Split(al1, "-")
            If UBound(s) > 0 Then s(0) = Format(s(0), "00-")
            s2 = Join(s, "-")
            If s1 > s2 Then
                Sheets(b).Move before:=Sheets(a)
                GoTo basla:
            End If
        Next
    Next

End Sub

 

[Merhum İdris SERDAR]

.

Bunu deneyin.

Sub sayfasirala()

Dim syf As Worksheet
Dim i As Integer, j As Integer

Application.ScreenUpdating = False

Set syf = ActiveSheet
For i = 1 To Sheets.Count
    For j = 1 To Sheets.Count - 1
        If Split(Sheets(j).Name, "-")(0) + 0 > Split(Sheets(j + 1).Name, "-")(0) + 0 Then
            Sheets(j).Move After:=Sheets(j + 1)
        End If
    Next j
Next i
syf.Activate

Application.ScreenUpdating = True

End Sub

.

 

[Ahmet TUNALI]

Sayın veyselemre ve Sayın İdris Serdar her ikinizede emeğiniz için teşekkür ederim .sayenizde sorunum çözüldü.
Herşey gönüllerinizce olsun.
Sağlıkla kalılın.