Aprenderemos hoy un truco de ordenación de datos empleando una macro de Excel. En concreto replicaremos el Método Burbuja de ordenamiento. Podemos leer algo más al respecto en nuestra amiga Wikipedia.
Vamos a replicar es este método por el cual se revisan cada elemento de una lista de valores que va a ser ordenada con el siguiente, intercambiándolos de posición si están en el orden equivocado (de mayor a meno o menor a mayor.
Lo que haremos será trabajar con los valores, asociándolos previamente a un Array, para luego replicar esa ordenación.
Para visualizar mucho mejor el funcionamiento de nuestra macro, comenzaremos viendo los datos a ordenar, vinculados a un gráfico de columnas:
Insertamos el siguiente código VBA en un módulo del Explorador de proyectos VBA:
Vamos a replicar es este método por el cual se revisan cada elemento de una lista de valores que va a ser ordenada con el siguiente, intercambiándolos de posición si están en el orden equivocado (de mayor a meno o menor a mayor.
Lo que haremos será trabajar con los valores, asociándolos previamente a un Array, para luego replicar esa ordenación.
Para visualizar mucho mejor el funcionamiento de nuestra macro, comenzaremos viendo los datos a ordenar, vinculados a un gráfico de columnas:
Insertamos el siguiente código VBA en un módulo del Explorador de proyectos VBA:
Option Base 1
Sub burbuja()
Dim NumEltos As Integer
Dim auxiliar As Integer
'definimos una Array de elementos a ordenar
Dim rng() As Integer
'Calculamos el número de elementos a ordenar
NumEltos = Range("B2:B22").Count
'Redefinimos la Array y la rellenamos de valores del rango B2:B22
ReDim rng(NumEltos) As Integer
For i = 1 To NumEltos
rng(i) = Sheets("Grafico").Cells(i + 1, 2).Value
Next i
y = 0
Do
'Método de Burbuja (siguiendo algoritmo de ordenamiento)
For i = NumEltos To 1 Step -1
For j = i To NumEltos
'ordenamos de mayor a menor
If rng(i) < rng(j) Then
auxiliar = rng(i)
rng(i) = rng(j)
rng(j) = auxiliar
End If
Next j
Next i
'mostramos el resultado de la primera ordenación
'recorriendo el rango B2:B22
For x = 2 To NumEltos + 1
Sheets("Grafico").Cells(x, 2) = rng(x - 1)
Next x
'Actualizamos pantalla para mostrar resultado en el gráfico
Application.ScreenUpdating = True
y = y + 1
'la repetimos tantas veces como elementos tengamos a ordenar en el rango
Loop Until y = NumEltos
End Sub
Podemos ver en la siguiente animación el funcionamiento de la macro:




No hay comentarios:
Publicar un comentario
Nota: solo los miembros de este blog pueden publicar comentarios.