ORDENAR RANGO DE NÚMEROS CON ALGORITMO DE BURBUJA Y PASAR DATOS A LA HOJA

Hola a todos!.

Hoy os dejo un pequeño post a modo respuesta a una consulta de este post: ALGORITMO DE ORDENACIÓN DE BURBUJA EN VBA Lo que me solicitan es poder pasar los datos ordenados de un rango de nuevo a la hoja, en el post los datos se pasaban a un msgbox.

Ya sé que existe la función Ordenar en Excel (de las nuevas funciones de matriz dinámica), pero lo que queremos conseguir es ordenar todo el rango seleccionado, no ordenar por fila o columna independiente.

Por ejemplo, tenemos estos rangos:

Y queremos ordenar todos los números de forma consecutiva con el mismo número de filas y columnas pero con los números ordenados. Es decir, así:

Efectivamente, todos los números del rango seleccionado se ordenar ocupando el mismo lugar consecutivamente. Lo he programado para que se ordene según esta estructura de datos, pero podéis realizar modificaciones a vuestro gusto vosotros mismos en el código, que por cierto os muestro a continuación:

Option Explicit
Sub Ordenar_Rango()
    'Declaramos variables
    Dim Rng         As Range, celda As Variant
    Dim Scadena     As String, Valor As Variant, i, MiCadena As String
    Dim miArray     As Variant, Control As Boolean, BetaString As Double
    Dim Valores     As Variant, n As Long, Micolumna As Long
    Dim Col         As Long, Fil As Long, contador As Long
    Dim Micelda     As Long
    'Seleccionamos rango con datos
    Set Rng = Selection
    Col = Rng.Columns.Count
    Fil = Rng.Rows.Count
    'Componemos cadena si la celda tiene datos y es un número
    For Each celda In Rng
        If celda <> vbNullString And IsNumeric(celda) Then
            MiCadena = MiCadena & " " & celda.Value
        End If
    Next celda
    Scadena = Trim(MiCadena)
    'Si la selección está vacía, salimos del procedimiento
    If Scadena = vbNullString Then Exit Sub
    'Pasamos la cadena a un array
    Valor = Split(Scadena, " ")
    ReDim miArray(0 To UBound(Valor))
    For i = 0 To UBound(Valor)
        miArray(i) = CDbl(Valor(i))
    Next i
    'Ordenamos con algoritmo
    Do
        Control = True
        For i = 0 To UBound(miArray) - 1
            If miArray(i) > miArray(i + 1) Then
                Control = False
                BetaString = miArray(i)
                miArray(i) = miArray(i + 1)
                miArray(i + 1) = BetaString
            End If
        Next i
    Loop While Not (Control)
    'Pasamos los datos a la hoja
    Valores = Split(Join(miArray, " "), " ")
    contador = 1
    Micelda = ActiveCell.Row
    Micolumna = ActiveCell.Column
    For n = LBound(Valores) To UBound(Valores)
        If contador <= Fil Then
            Cells(Micelda + contador - 1, Micolumna + Col + 1).Value = Valores(n)
            contador = contador + 1
        Else
            n = n - 1
            contador = 1
            Micolumna = Micolumna + 1
        End If
    Next n
End Sub

Es un poco largo, pero siguiendo los comentarios y probando las diferentes partes de la rutina es sencillo comprender lo que estamos haciendo.

Obviamente lo realmente importante de este post no es el algoritmo de Burbuja, sino la parte en la que pasamos los datos del array a la hoja mediante un loop.

Este código se podría implementar como una UDF pero creo que es tanto o más interesante como un procedimiento Sub. También lo podremos hacer en otros lenguajes, pero hoy le toca a VBA 🙂

Puedes descargar aquí el archivo:

Y esto es todo, espero que os sea de utilidad!.

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.



¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies