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 SubPodemos 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.