Ordenar el tab de hojas, pero correctamente

[Antoni]

Hola:

El título lo dice todo:

Sub OrdenarPorNombreHoja()


   Dim Orden(), Código, Fila, Hoja


    Columns(Columns.Count).Clear

    Columns(Columns.Count - 1).Clear

    For Each Hoja In Sheets

       Código = ""

       For x = Len(Hoja.Name) To 1 Step -1

          If IsNumeric(Mid(Hoja.Name, x, 1)) Then

             Código = Mid(Hoja.Name, x, 1) & Código

          Else

             Exit For

          End If

       Next

       Fila = Fila + 1

       Cells(Fila, Columns.Count - 1) = Hoja.Name

       Cells(Fila, Columns.Count) = Left(Hoja.Name, x) & _

             String(10 - Len(Código), "0") & Código

    Next


    Range(Cells(1, Columns.Count - 1), Cells(Fila, Columns.Count)).SortSpecial _

       Key1:=Columns(Columns.Count), Order1:=xlDescending


    ReDim Orden(Fila)

    For x = 1 To Fila

       Orden(x) = Cells(x, Columns.Count - 1)

    Next


    Columns(Columns.Count).Clear

    Columns(Columns.Count - 1).Clear


    For x = 1 To Fila

       Sheets(Orden(x)).Move Before:=Sheets(1)

    Next



End Sub[/CODE]

¿Que tiene de especial esta macro con relación a otras parecidas?, pues, el ordenamiento se hace en dos partes

La parte Alfanumérica primero, como, texto, y la parte numérica segundo, como número.

Espero que se entienda la diferencia, pero si no, solo teneis que probarlo.

[Gerson Pineda]

Hola

Siguiendo con tu idea elabore esto: [DBOX]. . . . Gerson Pineda-El Catracho: Ordenar Hojas Tipo ABC_123[/DBOX]

Saludos

[Antoni]

Gerson:

He probado tu aporte, y ordena las hojas como texto.

De esta manera tres hojas de nombres Hoja101, Hoja3 y Hoja20 quedan ordenadas así:

Hoja101, Hoja20, Hoja3

Cuando lo que yo propongo es que queden así:

Hoja3, Hoja20, Hoja101

Es decir, ordenadas por la parte numérica cuando coincide la parte alfanumérica.

Saludos

[verzulsan]

Muchas gracias Antoni, me ha sido muy útil.

Lo único que le he cambiado ha sido la forma de borrar las columnas ya que tras ordenar quedaban usadas las 2 últimas columnas y ralentizaba mucho la hoja usada como auxiliar.

Union(Columns(Columns.Count - 1), Columns(Columns.Count)).Delete Shift:=xlToLeft[/CODE]

Y luego como curiosidad, he visto (Y esto lo he visto de chiripa) que la instrucción Move ofrece 4 posibilidades curiosas:

[CODE] 'Ordenacion separada (Deja las visibles arriba y ocultas debajo)
'Sheets(Orden(x)).Move After:=Sheets(Sheets.Count)

'Ordenacion separada (Deja las visibles abajo)
'Sheets(Orden(x)).Move After:=Sheets(1)

'Ordenacion separada (Deja las visibles abajo)
'Sheets(Orden(x)).Move Before:=Sheets(1)

'Ordena conjuntamente las visibles y ocultas)
Sheets(Orden(x)).Move before:=Sheets(Sheets.Count)[/CODE]

Lo he visto por que tengo una hoja “Panel” en la que listo todas las hojas del libro (Las visibles las marco de verde y las ocultas de rojo), pues tras ordenar, según la posibilidad que esté marcada de las 4 que pongo arriba, me agrupa las visibles arriba o abajo o me las ordena todas mezcladas, lo cual me es extremadamente útil para lo que ando haciendo.

Una penúltima cosa que he puesto es, que antes de ordenar, guardo la hoja y celda activa para que tras ordenar me devuelva al mismo sitio ya que si no quedo en otra hoja distinta que no viene a cuento.

Y ya por último, he tenido que desactivar y reactivar eventos para que no salte el WorkSheetChange cada vez que usas las columnas auxiliares (La primera vez me colgo la hoja pero afortunadamente habia guardado los cambios)

Pongo el código modificado (Lo importante esta sin tocar, me ha molado mucho lo de cazar el numero a la inversa con una variable buffer )

[CODE]Sub OrdenarPorNombreHoja()
Dim Orden(), Código As String, Fila As Long, Hoja As Worksheet
Dim HojaActiva As Worksheet: Set HojaActiva = ActiveSheet
Dim CeldaActiva As Range: Set CeldaActiva = ActiveCell

Application.EnableEvents = False
Application.ScreenUpdating = False

Union(Columns(Columns.Count - 1), Columns(Columns.Count)).Delete Shift:=xlToLeft

For Each Hoja In Sheets
Código = ""
For x = Len(Hoja.Name) To 1 Step -1
If IsNumeric(Mid(Hoja.Name, x, 1)) Then
Código = Mid(Hoja.Name, x, 1) & Código
Else
Exit For
End If
Next
Fila = Fila + 1
Cells(Fila, Columns.Count - 1) = Hoja.Name
Cells(Fila, Columns.Count) = Left(Hoja.Name, x) & _
String(10 - Len(Código), "0") & Código
Next

Range(Cells(1, Columns.Count - 1), Cells(Fila, Columns.Count)).SortSpecial _
Key1:=Columns(Columns.Count), Order1:=xlDescending

ReDim Orden(Fila)
For x = 1 To Fila
Orden(x) = Cells(x, Columns.Count - 1)
Next

Union(Columns(Columns.Count - 1), Columns(Columns.Count)).Delete Shift:=xlToLeft

For x = 1 To Fila
'Ordenacion separada (Deja las visibles arriba y ocultas debajo)
'Sheets(Orden(x)).Move After:=Sheets(Sheets.Count)

'Ordenacion separada (Deja las visibles abajo)
'Sheets(Orden(x)).Move After:=Sheets(1)

'Ordenacion separada (Deja las visibles abajo)
'Sheets(Orden(x)).Move Before:=Sheets(1)

'Ordena conjuntamente las visibles y ocultas)
Sheets(Orden(x)).Move before:=Sheets(Sheets.Count)
Next

Application.ScreenUpdating = True
Application.EnableEvents = True

HojaActiva.Activate
CeldaActiva.Select

End Sub[/CODE]

Un saludo amigo, tus aportes siempre tan útiles cuando no interesantes como siempre