Formulario ordenar mediante varios criterios






En el post anterior se mostró como como ordenar Datos automáticamente, como así también ordenar automaticamente en base a varios criterios, ordenar por varias columnas en forma ascendente y descendente y en ordenar datos al activar hoja, se mostró en detalle varias formas de ordenar datos mediante macros o Código de VBA, aquí les presento una versión que sirve para ordenar datos, la diferencia con los otros ejemplos radica en que los criterios se eligen de un combobox que se encuentran en un formulario, pudiendo establecer si los datos se requieren ordenar en forma ascendente o descendente .

Antes de seguir recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

De todos Los ejemplos sobre ordenar datos presentados en esta web, este es el más complejo y completo, no se debe hacer nada para ordenar los datos, ya que la macro automáticamente determina el rango, solo se necesita que antes de ordenar los datos se debe determinar el criterio por el cual ordenar y si es en forma ascendente o descendente.

El Código de VBA en primer lugar determinación la última fila con datos y la última columna del rango, posteriormente hace una serie de validaciones en los datos ingresados ​​en los combobox, posteriormente arma el rango a ordenar en forma automática, la macro determina si se ingresó uno, dos, tres o cuatro criterios, por último procede a ordenar el los datos.

Desde el enlace del final de se puede descargar el archivo de ejemplo de macro de esta manera se podrá ver el funcionamiento en detalle. El  Código de VBA o  macro de Excel  Ordena automáticamente un listado hojas de Excel, previo sí debe elegir de un combobox,  insertado en el userform, el criterio por el que se requiere ordenar, como así también se necesita se seleccione si se desea ordenar en forma ascendente o descendente.

El vídeo que sigue muestra una explicación más detallada y gráfica de la macro presentada, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo formulario que crea un listado de todas las hojas para poder luego seleccionarlasbuscar en listbox mientras escribes en textboxordenar hojas libro excel por su nombreconectar Excel con Access y muchos ejemplos más.








Código que se debe insertar en la hoja de trabajo de la hoja de donde ejecutaremos la macro





Sub muestra()
UserForm1.show
End Sub

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub CommandButton2_Click()
'Application.ScreenUpdating = False
'On Error Resume Next

Dim uf, ucw, r1, r2, Cb1, Cb2, Cb3, Cb4, or1, or2, or3, or4 As String
Dim cri1, cri2, cri3, cri4 As String
Dim x, ucn As Integer


Sheets("Hoja1").Select
'determines last row with data

uf = Sheets("hoja1").Range("A" & Rows.Count).End(xlUp).Row
uc = Sheets("hoja1").Cells("1," & Columns.Count).End(xlToRight).Address(False, False)
ucw = Mid(uc, 1, 1)
ucn = Sheets("hoja1").Cells("1," & Columns.Count).End(xlToRight).Column


'Verifique que no se seleccione el mismo criterio de orden en caso que el combo voz no este vacio

If ComboBox1 = Empty Then
MsgBox ("Debe ingresar criterio de orden 1"), vbInformation, "AVISO"
ComboBox1.SetFocus
Exit Sub
End If

If ComboBox2 <> Empty Then
  If ComboBox1 = Empty Then
  MsgBox ("Ingrese criterio de orden 1"), vbInformation, "ALERTA"
  ComboBox1.SetFocus
  Exit Sub
  End If

  If ComboBox2 = ComboBox1 Or ComboBox2 = ComboBox3 Or ComboBox2 = ComboBox4 Then
  MsgBox ("El criterio de orden está duplicado, verifique"), vbInformation, "ALERTA"
  ComboBox2.SetFocus
  Exit Sub
  End If
End If


If ComboBox3 <> Empty Then

  If ComboBox2 = Empty Then
  MsgBox ("Ingrese criterio de orden 2"), vbInformation, "ALERTA"
  ComboBox2.SetFocus
  Exit Sub
  End If

  If ComboBox3 = ComboBox1 Or ComboBox3 = ComboBox2 Or ComboBox3 = ComboBox4 Then
  MsgBox ("El criterio de orden está duplicado, verifique"), vbInformation, "ALERTA"
  ComboBox2.SetFocus
  Exit Sub
  End If
End If


If ComboBox4 <> Empty Then

  If ComboBox3 = Empty Then
  MsgBox ("Ingrese criterio de orden 3"), vbInformation, "ALERTA"
  ComboBox3.SetFocus
  Exit Sub
  End If

  If ComboBox4 = ComboBox1 Or ComboBox4 = ComboBox2 Or ComboBox4 = ComboBox3 Then
  MsgBox ("El criterio de orden está duplicado, verifique"), vbInformation, "ALERTA"
  ComboBox2.SetFocus
  Exit Sub
  End If
End If


'will help determine ranges to sort data
Cb1 = ComboBox1
'Determino donde están los criterios de orden
cri1 = Sheets("hoja1").Cells(1, 1)
cri2 = Sheets("hoja1").Cells(1, 2)
cri3 = Sheets("hoja1").Cells(1, 3)
cri4 = Sheets("hoja1").Cells(1, 4)

'Determino el valor de cada combobox y en base a ello el rango donde esta el criteri de orden
Select Case Cb1
Case Is = cri1
k = Sheets("hoja1").Cells(1, 1).Address(False, False)
k1 = Mid(k, 1, 1)
r1 = k & ":" & k1 & uf

Case Is = cri2
m = Sheets("hoja1").Cells(1, 2).Address(False, False)
m1 = Mid(m, 1, 1)
r1 = m & ":" & m1 & uf

Case Is = cri3
n = Sheets("hoja1").Cells(1, 3).Address(False, False)
n1 = Mid(n, 1, 1)
r1 = n & ":" & n1 & uf

Case Is = cri4
o = Sheets("hoja1").Cells(1, 4).Address(False, False)
o1 = Mid(o, 1, 1)
r1 = o & ":" & o1 & uf
End Select


Cb2 = ComboBox2
Select Case Cb2
Case Is = cri1
k = Sheets("hoja1").Cells(1, 1).Address(False, False)
k1 = Mid(k, 1, 1)
r2 = k & ":" & k1 & uf

Case Is = cri2
m = Sheets("hoja1").Cells(1, 2).Address(False, False)
m1 = Mid(m, 1, 1)
r2 = m & ":" & m1 & uf

Case Is = cri3
n = Sheets("hoja1").Cells(1, 3).Address(False, False)
n1 = Mid(n, 1, 1)
r2 = n & ":" & n1 & uf

Case Is = cri4
o = Sheets("hoja1").Cells(1, 4).Address(False, False)
o1 = Mid(o, 1, 1)
r2 = o & ":" & o1 & uf
End Select


Cb3 = ComboBox3
Select Case Cb3
Case Is = cri1
k = Sheets("hoja1").Cells(1, 1).Address(False, False)
k1 = Mid(k, 1, 1)
r3 = k & ":" & k1 & uf

Case Is = cri2
m = Sheets("hoja1").Cells(1, 2).Address(False, False)
m1 = Mid(m, 1, 1)
r3 = m & ":" & m1 & uf

Case Is = cri3
n = Sheets("hoja1").Cells(1, 3).Address(False, False)
n1 = Mid(n, 1, 1)
r3 = n & ":" & n1 & uf

Case Is = cri4
o = Sheets("hoja1").Cells(1, 4).Address(False, False)
o1 = Mid(o, 1, 1)
r3 = o & ":" & o1 & uf
End Select


Cb4 = ComboBox4
Select Case Cb4
Case Is = cri1
k = Sheets("hoja1").Cells(1, 1).Address(False, False)
k1 = Mid(k, 1, 1)
r4 = k & ":" & k1 & uf

Case Is = cri2
m = Sheets("hoja1").Cells(1, 2).Address(False, False)
m1 = Mid(m, 1, 1)
r4 = m & ":" & m1 & uf

Case Is = cri3
n = Sheets("hoja1").Cells(1, 3).Address(False, False)
n1 = Mid(n, 1, 1)
r4 = n & ":" & n1 & uf

Case Is = cri4
o = Sheets("hoja1").Cells(1, 4).Address(False, False)
o1 = Mid(o, 1, 1)
r4 = o & ":" & o1 & uf
End Select


r5 = "A1:" & ucw & uf

If OptionButton1 = False Then
or1 = xlDescending
Else
or1 = xlAscending
End If

If OptionButton3 = False Then
or2 = xlDescending
Else
or2 = xlAscending
End If

If OptionButton5 = False Then
or3 = xlDescending
Else
or3 = xlAscending
End If

If OptionButton7 = False Then
or4 = xlDescending
Else
or4 = xlAscending
End If




'sorts the data
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Clear

If ComboBox1 <> Empty And ComboBox2 = Empty And ComboBox3 = Empty And ComboBox4 = Empty Then
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r1) _
        , SortOn:=xlSortOnValues, Order:=or1, DataOption:=xlSortNormal
End If

If ComboBox1 <> Empty And ComboBox2 <> Empty And ComboBox3 = Empty And ComboBox4 = Empty Then
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r1) _
        , SortOn:=xlSortOnValues, Order:=or1, DataOption:=xlSortNormal
 ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add Key:=Range(r2) _
        , SortOn:=xlSortOnValues, Order:=or2, DataOption:=xlSortNormal
End If

If ComboBox1 <> Empty And ComboBox2 <> Empty And ComboBox3 <> Empty And ComboBox4 = Empty Then
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r1) _
        , SortOn:=xlSortOnValues, Order:=or1, DataOption:=xlSortNormal
 ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add Key:=Range(r2) _
        , SortOn:=xlSortOnValues, Order:=or2, DataOption:=xlSortNormal
 ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add Key:=Range(r3) _
        , SortOn:=xlSortOnValues, Order:=or3, DataOption:=xlSortNormal
End If

If ComboBox1 <> Empty And ComboBox2 <> Empty And ComboBox3 <> Empty And ComboBox4 <> Empty Then
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r1) _
        , SortOn:=xlSortOnValues, Order:=or1, DataOption:=xlSortNormal
 ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add Key:=Range(r2) _
        , SortOn:=xlSortOnValues, Order:=or2, DataOption:=xlSortNormal
 ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add Key:=Range(r3) _
        , SortOn:=xlSortOnValues, Order:=or3, DataOption:=xlSortNormal
 ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add Key:=Range(r4) _
        , SortOn:=xlSortOnValues, Order:=or4, DataOption:=xlSortNormal
End If

With ActiveWorkbook.Worksheets("hoja1").Sort
        .SetRange Range(r5)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With

Sheets("hoja1").Cells(1, 1).Select
MsgBox ("Los datos se han ordenado con éxito"), vbInformation, "AVISO"
'Application.ScreenUpdating = False
End Sub


Private Sub CommandButton3_Click()
ComboBox1 = Clear
ComboBox2 = Clear
ComboBox3 = Clear
ComboBox4 = Clear
End Sub

Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
ComboBox1 = Clear
ComboBox2 = Clear
ComboBox3 = Clear
ComboBox4 = Clear

Sheets("hoja1").Select
Range("a1").Select
While ActiveCell <> Empty
ComboBox1.AddItem ActiveCell
ComboBox2.AddItem ActiveCell
ComboBox3.AddItem ActiveCell
ComboBox4.AddItem ActiveCell
ActiveCell.Offset(0, 1).Select
Wend
Application.ScreenUpdating = True
End Sub







Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si Te Gusto Por favor Compártelo Con Tus amigos
Si te gustó  , por favor  compártela con tus  amigos