sheetler harf sırasına göre dizilebilirmi.....

[sisozen]

merhaba arkadaşlar..
excel de diyelim 30 kadar karışık şekilde açılmış sheet ler var bunları harf sırasına göre nasıl dizebiliriz.(sürükle bırak yöntemine başvurmadan tabi.)

 

[jale]

Aşağıdaki linklere bakınız.

http://www.excel.web.tr/showthread.php?t=4829&highlight=harf+s%FDras%FDna

 

[Ali]

Sub SortSheets()

    Dim SheetNames() As String
    Dim SheetHidden() As Boolean
    Dim i As Integer
    Dim SheetCount As Integer
    Dim VisibleWins As Integer
    Dim Item As Object
    Dim OldActive As Object

    If ActiveWorkbook Is Nothing Then Exit Sub
    SheetCount = ActiveWorkbook.Sheets.Count
    
    If ActiveWorkbook.ProtectStructure Then
        MsgBox ActiveWorkbook.Name & " is protected.", _
            vbCritical, "Cannot Sort Sheets."
        Exit Sub
    End If
    Application.EnableCancelKey = xlDisabled

    SheetCount = ActiveWorkbook.Sheets.Count

    ReDim SheetNames(1 To SheetCount)
    ReDim SheetHidden(1 To SheetCount)
    Set OldActive = ActiveSheet

    For i = 1 To SheetCount
        SheetNames(i) = ActiveWorkbook.Sheets(i).Name
  
    Next i
    For i = 1 To SheetCount
        SheetHidden(i) = Not ActiveWorkbook.Sheets(i).Visible

        If SheetHidden(i) Then ActiveWorkbook.Sheets(i).Visible = True
    Next i
    
    Call BubbleSort(SheetNames)
    
    Application.ScreenUpdating = False

    For i = 1 To SheetCount
        ActiveWorkbook.Sheets(SheetNames(i)).Move _
            before:=ActiveWorkbook.Sheets(i)
    Next i
      
    For i = 1 To SheetCount
        If SheetHidden(i) Then ActiveWorkbook.Sheets(i).Visible = False
    Next i
     
    OldActive.Activate
    
End Sub
Sub BubbleSort(List() As String)
    
    Dim First As Integer
    Dim Last As Integer
    Dim i As Integer
    Dim j As Integer
    Dim Temp As String
    
    First = LBound(List)
    Last = UBound(List)
    For i = First To Last - 1
        For j = i + 1 To Last
            If UCase(List(i)) > UCase(List(j)) Then
                Temp = List(j)
                List(j) = List(i)
                List(i) = Temp
            End If
        Next j
    Next i
    
End Sub

İngilizce bir forumdan alıntıdır. Biraz uzun ama alternatif olarak dursun dedim.

Farkı gizli sayfalarda olsa bunlarıda hesaba katıp alfabetik sıralar..

 

[Haluk]

Farkı gizli sayfalarda olsa bunlarıda hesaba katıp alfabetik sıralar..

Alternatif için teşekkürler,

Gizli sayfaları da değerlendirmeye alması güzel fakat, İstanbul .... falan gibi Türkçe karakterlerde sorunlu.

İyi akşamlar.

 

[Ali]

Haklısınız Haluk Hocam. Levent Beyin'de kodlarını denedim oradada Türkçe karekterde sorun oldu.

Bende yukarıdaki kodlar ve sizin kodları birlikte çalıştırınca gizli sayfa ,türkçe karakter sorunu kalmadı. Yolu biraz uzattık ama

 

[Korhan Ayhan]

Selamlar,

Konuyla ilgili bir alternatifte ben sunmak istedim. Gizli sayfalarıda sıralıyor ve türkçe karakter sıkıntısıda yaratmıyor.

Sub SAYFALARI_ALFABETİK_SIRALA()
    Application.ScreenUpdating = False
    Sheets(1).Select
    Say = Sheets.Count
    If Say < 2 Then Exit Sub
    Sheets.Add
    ActiveSheet.Name = "Liste"
    For X = 2 To Sheets.Count
    Sheets("Liste").Cells(X - 1, 1) = Sheets(X).Name
    If Sheets(X).Visible = False Then
    Sheets(X).Visible = True
    Sheets("Liste").Cells(X - 1, 2) = "Gizli"
    End If
    Next
    Columns("A:B").Sort Key1:=Range("A1"), Order1:=xlAscending
    [A1].Select
    
    For Y = 2 To Sheets.Count
    Sheets("" & Cells(Y - 1, 1)).Move Before:=Sheets(Y)
    Sheets("Liste").Select
    If Sheets("Liste").Cells(Y - 1, 2) = "Gizli" Then
    Sheets("" & Cells(Y - 1, 1)).Visible = False
    End If
    Next
    Application.DisplayAlerts = False
    Sheets("Liste").Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[sisozen]

hocalarıma ilgilerinden dolayı teşekkür ederim.