Programación

Vamos a analizar distintos códigos de VBA para Office y poder sacarles el máximo rendimineto.

Ordenar Hojas

Ordenar Excel

Por Héctor Miguel Orozco Diáz

Válida para todas las versiones de Office 97-XP-2003-2007-2010

Siguiendo con la Necesidad de realizar nuestro trabajo con el mínimo esfuerzo, aquí os dejamos un procedimiento que nos Ordena nuestra hojas del Libro según nosotros queramos, bien sea en orden ascendente o descendente o bien sea distinguiendo entre [may/min]usculas.

NO importa si son [may/min]usculas, el procedimiento "pregunta" si quieres usar un orden descendente:

Sub OrdenaHojas(): On Error GoTo DoNothing2 ' NO importa si son [may/min]usculas '
  Debug.Print ActiveSheet.Type
  Dim x As String, n As Integer, a As Integer, b As Integer
  Select Case MsgBox("Ordenar en descendente ?", vbYesNoCancel, "Ordenar las hojas...")
    Case vbNo: x = "<": Case vbYes: x = ">": Case vbCancel: Exit Sub
  End Select: Application.ScreenUpdating = False
  With ActiveSheet: With ActiveWorkbook.Worksheets
      For n = 1 To .Count: b = n: For a = n + 1 To .Count
          If Evaluate("""" & .Item(a).Name & """" & x & """" & .Item(b).Name & """") Then b = a
        Next: If b  n Then .Item(b).Move .Item(n)
      Next: End With: .Select: End With
DoNothing2:
End Sub 

SI importa que se distingua entre [may/min]usculas:

Sub OrdenaHojasM(): On Error GoTo DoNothing3 ' SI se distingue entre [may/min]usculas '
  Debug.Print ActiveSheet.Type
  Dim Sig As Integer, Ant As Integer, Post As Integer, Desc As Boolean
  Select Case MsgBox("Ordenar en descendente ?", vbYesNoCancel, "Ordenar las hojas...")
    Case vbNo: Desc = True: Case vbYes: Desc = False: Case vbCancel: Exit Sub
  End Select: Application.ScreenUpdating = False
  With ActiveSheet: With ActiveWorkbook.Worksheets
      For Sig = 1 To .Count: Post = Sig: For Ant = Sig + 1 To .Count
          If Desc Then
            If .Item(Ant).Name > .Item(Post).Name Then Post = Ant
          Else
            If .Item(Ant).Name < .Item(Post).Name Then Post = Ant
          End If: Next: If Post  Sig Then .Item(Post).Move .Item(Sig)
      Next: End With: .Select: End With
DoNothing3:
End Sub

 

Imprimir