Sayfa adlarını ada göre sıralama

[özgür33]

Merhaba arkadaşlar,
Benim sorunum Kitapta yer alan sayfa adlarını ada göre sıralama yapabılırmiyim.
Yani Sayfa adı Ali Yüksel,Zeki Sağlam, Veli, Suna şeklinde 60 tane sayfam var. Ben bunları Ali Yüksel, Suna, Veli , Zeki şeklinde yapabilirmiyim?

Teşekkürler,..

 

[Merhum İdris SERDAR]

Sub sayfasirala()
For a = 1 To Sheets.Count
For b = a + 1 To Sheets.Count
If Sheets(b).Name > Sheets(a).Name Then GoTo 10
Sheets(b).Move before:=Sheets(a)
10 Next
Next
End Sub

Kodunu kullanın. Ancak, bu kod Türkçe karakterleri sıralamaz.

Türçe karekterler için de aşağıdaki kodu kullanabilirsiniz.


Sub sayfasirala()
Dim ShArr() As String
Dim i As Integer
Dim ShNo As Long
Dim WordBasic As Object

ShNo = Worksheets.Count
ReDim ShArr(1 To ShNo)

For i = 1 To ShNo
ShArr(i) = Sheets(i).Name
Next

Set WordBasic = CreateObject("Word.Basic")
WordBasic.SortArray ShArr()

For i = ShNo - 1 To 1 Step -1
Sheets(ShArr(i)).Move Before:=Sheets(ShArr(i + 1))
Next

Set WordBasic = Nothing
End Sub

 

[Ali]

Aşağıdaki linki inceleyiniz.

http://www.excel.web.tr/showthread.php?t=19575&highlight=alfabetik

 

[Levent Menteşoğlu]

Alternatif olarak aşağıdaki koduda deneyebilirsiniz. Gizli sayfalarıda sıraladığı gibi Türkçe karakterlerde de bir sorun olmayacaktır.

Sub sayfasirala()
Application.ScreenUpdating = False
Sheets.Add
ActiveSheet.Move After:=Sheets(Sheets.Count)
Set s1 = Sheets(Sheets.Count)
For a = 1 To Sheets.Count - 1
s1.Cells(a, "a") = Sheets(a).Name
s1.[a:a].Sort Key1:=s1.[a1]
deg = Sheets(a).Name
If IsNumeric(deg) = True Then deg = Val(Sheets(a).Name)
say = WorksheetFunction.Match(deg, s1.[a:a], 0)
Sheets(a).Move Before:=Sheets(say)
Next
Application.DisplayAlerts = False
s1.Delete
End Sub

 

[hsayar]

Sayın hıcam kodlarınız çok mükemmel
ancak bu sıralamadan bazı sayfaları muaf tutmak yada yada onları önce onları sıralayıp diğer sayfaları ardında sırlamak mümkünmüdür?

[B](General)(Declarations)[/B]
...............................
Public ckBU_Klc_SfAd() As Variant        'bu kitapta daima kalacak sayfa adları
Public ckBU_Klc_SfIx As Integer          'bu kitapta daima kalacak enson indeks no
Public ckBU_Klc_SfSy As Integer          'bu kitapta daima kalacak sayfa sayısı
.................................

Sub DegiskenAl()
............................................
ckBU_ss = ckBU.Worksheets.Count                  'bu kitabın sayfa sayısı
'//////////////////////Dizilerle ilgili değerler
'daima bu kitapta kalacak sayfa adlarına ait dizi
[color=Red][B]ckBU_Klc_SfAd = Array(ckBU_sfSAT.Name, ckBU_sfALS.Name, ckBU_sfTNM.Name, ckBU_sfTSB.Name, _
                      ckBU_sfAYL.Name, ckBU_sfYIL.Name, ckBU_sfDVR.Name)  'daima bu kitapta kalacak sayfa adları
[/color][/B]
ckBU_Klc_SfIx = UBound(ckBU_Klc_SfAd)
ckBU_Klc_SfSy = ckBU_Klc_SfIx + 1
................................

örneğinde
ckBU_sfSAT.Name> 1. sırada
ckBU_sfALS.Name> 2. sırada
ckBU_sfTNM.Name> 3. sırada
ckBU_sfTSB.Name> 4. sırada
ckBU_sfAYL.Name> 5. sırada
ckBU_sfYIL.Name> 6. sırada
ckBU_sfDVR.Name> 7. sırada
0111
0211
0311
0511
0611
0411
0711
1011
2011
0811
0911
1111
1511
1311
1211
1411

işte hangi sıra geliyorsa o şekilde olmalı

 

[baydeniro]

Paylaşım için teşekkürler.

 

[u.L.a.s]

Alternatif olarak aşağıdaki koduda deneyebilirsiniz. Gizli sayfalarıda sıraladığı gibi Türkçe karakterlerde de bir sorun olmayacaktır.

Sub sayfasirala()
Application.ScreenUpdating = False
Sheets.Add
ActiveSheet.Move After:=Sheets(Sheets.Count)
Set s1 = Sheets(Sheets.Count)
For a = 1 To Sheets.Count - 1
s1.Cells(a, "a") = Sheets(a).Name
s1.[a:a].Sort Key1:=s1.[a1]
deg = Sheets(a).Name
If IsNumeric(deg) = True Then deg = Val(Sheets(a).Name)
say = WorksheetFunction.Match(deg, s1.[a:a], 0)
Sheets(a).Move Before:=Sheets(say)
Next
Application.DisplayAlerts = False
s1.Delete
End Sub

Merhabalar

bu kodda bütün sheetleri ada göre sıralıyor.

Fakat ben normalde henüz sıralatmadan önceki ilk 4 sheeti başta yine bıraksın diğer sheetleri ada göre sıralatsın istiyorum bilgi ve yardımlarınızı rica ederim