Sección de códigos , trucos y ejemplos para visual basic

107 - Ejemplo de ordenación de un vector o array utilizando el método Quicksort

Contenido de la página

Método QuickSort
Módulo bas con funciones de ordenamiento
Ordenar array de archivos
Ordenar registros de un archivo de texto
Enlaces relacionados

1 - QuickSort

Este ejemplo ordena un vector o array que se llena con números aleatorios. Esos números se visualizan en un control ListBox. Luego para ordenarlos se llama a una función llamada Ordenar. A esta función se le pasa el vector como parámetro. Por último, una ves devuelto el vector ordenado, se recorre el mismo en un For-next y se agregan en un segundo ListBox

ejemplo de ordenación de vectores en visual basic utilizando el método quicksort

Colocar los siguiente controles como están en la imagen:

Un control text1 que será la cantidad de elementos del vector a ordenar.
2 controles ListBox, El list1 carga el vector desordenado con lo números aleatorios. El List2 visualiza el resultado del vector ordenado
Dos CommandButton. El command1 Llena el vector con números aleatorios, el Command2 Ordena el vector.

Código en un módulo bas:

Dim vecMenor() As Long, vecMayor() As Long Dim a, sl, pRight, pLeft, iEnd, Max, star, pos As Long Public Sub ordenar2(elVector() As Long) If Not entre Then pLeft = star pRight = iEnd pos = star entre = False End If While elVector(pos) <= elVector(pRight) And (pos <> pRight) pRight = pRight - 1 Wend If pos = pRight Then Exit Sub ElseIf elVector(pos) > elVector(pRight) Then Temp = elVector(pos) elVector(pos) = elVector(pRight) elVector(pRight) = Temp pos = pRight End If While elVector(pLeft) <= elVector(pos) And (pLeft <> pos) pLeft = pLeft + 1 Wend If pos = pLeft Then Exit Sub ElseIf elVector(pLeft) > elVector(pos) Then Temp = elVector(pos) elVector(pos) = elVector(pLeft) elVector(pLeft) = Temp pos = pLeft End If ordenar2 elVector End Sub Public Function Ordenar(elVector() As Long) As Long() ReDim vecMenor(UBound(elVector)) As Long ReDim vecMayor(UBound(elVector)) As Long Max = 0 If UBound(elVector) > 1 Then Max = Max + 1 vecMenor(1) = 1 vecMayor(1) = UBound(elVector) End If While Max <> 0 star = vecMenor(Max) iEnd = vecMayor(Max) Max = Max - 1 ordenar2 elVector If star < pos - 1 Then Max = Max + 1 vecMenor(Max) = star vecMayor(Max) = pos - 1 End If If pos + 1 < iEnd Then Max = Max + 1 vecMenor(Max) = pos + 1 vecMayor(Max) = iEnd End If Wend Ordenar = elVector End Function

Código fuente en el formulario:

'Dim vector a ordenar Dim UnVector() As Long Private Sub Command1_Click() Dim x As Long, i As Integer List1.Clear List2.Clear x = CInt(Text1) ReDim UnVector(x) 'Llenamos el vector con números aleatorios For i = 1 To x Randomize (x) UnVector(i) = (2500450 * Rnd) 'Agregamos los números aleatorios al List List1.AddItem UnVector(i) Next Command1.Enabled = False Command2.Enabled = True End Sub Private Sub Command2_Click() 'Pasamos a la función el Vector (la función devuelve el vector ordenado) UnVector = Ordenar(UnVector) 'Recorremos el vector ordenado y lo agregamos al List2 For i = 1 To UBound(UnVector) List2.AddItem UnVector(i) Next Command1.Enabled = True Command2.Enabled = False End Sub

2 - Módulo bas con 5 rutinas de ordenamiento

Módulo enviado por Luis Nuñez

Este bas contiene cinco funciones de ordenamiento de datos , incluyendo el algoritmo QuickSort, BubbleSort y de Selección

Descargar módulo Sort.bas

3 - Ordenar archivos

Este ejemplo utiliza el método de ordenación QuickSort para ordenar un array que contiene cargado una lista de archivos. La ordenación se realiza de acuerdo al tamaño de los archivos en modo ascendente. El resultado se visualiza en un control TextBox

Colocar en un formulario :

Una caja de texto : txtResult ( Colocar la propiedad Multilinea en True )
Un botón : cmdSort

Vista previa del Form

Código fuente

Option Explicit ' --------------------------------------------------------------------------------------- ' \\ -- Autor del ejemplo : Luciano Lodola -- http://www.recursosvisualbasic.com.ar ' \\ -- Nota. La función de ordenación está adaptada de un ejemplo creado por Randy Birch) ' --------------------------------------------------------------------------------------- ' -- UDT para los datos Private Type tData sFileName As String ' -- Campo para el Nombre del archivo curFileSize As Currency ' -- Campo para el tamaño ( expresado en bytes) End Type ' -- Declarar matriz de datos ( almacenará una lista de archivos) Private the_array() As tData ' --------------------------------------------------------------------------------------- ' \\ -- Función para ordenar el array de acuerdo al campo numérico del UDT ' -- Recibe el array, y el índice bajo y alto ' --------------------------------------------------------------------------------------- Private Sub QuickSort(the_array() As tData, l As Currency, r As Currency) Dim i As Currency Dim j As Currency Dim X As Currency Dim Y As tData i = l j = r X = the_array((l + r) / 2).curFileSize While (i <= j) While (the_array(i).curFileSize < X And i < r) i = i + 1 Wend While (X < the_array(j).curFileSize And j > l) j = j - 1 Wend If (i <= j) Then Y.curFileSize = the_array(i).curFileSize Y.sFileName = the_array(i).sFileName the_array(i).curFileSize = the_array(j).curFileSize the_array(i).sFileName = the_array(j).sFileName the_array(j).curFileSize = Y.curFileSize the_array(j).sFileName = Y.sFileName i = i + 1 j = j - 1 End If Wend If (l < j) Then Call QuickSort(the_array, l, j) End If If (i < r) Then Call QuickSort(the_array, i, r) End If End Sub ' ----------------------------------------------------------------------------------------- ' \\ -- Botón para ordenar el array ' ----------------------------------------------------------------------------------------- Private Sub cmdSort_Click() Dim sPath As String ' -- Abrir inputbox para el directorio sPath = InputBox("Escribir un directorio válido", , Environ("windir")) If Len(sPath) = 0 Then Exit Sub ' -- Cargar array ( por defecto enviar el directorio de windows ) Call Fill_Array(sPath) ' -- Llamar a la función para ordenar con QuickSort Call QuickSort( _ the_array, _ LBound(the_array), _ UBound(the_array)) ' -- Mostrar ahora el array en listbox, con los datos ordenados por el campo ( "Tamaño de archivo") Dim i As Long For i = LBound(the_array) To UBound(the_array) 'lstFiles.AddItem the_array(i).sFileName txtResult.Text = txtResult.Text & the_array(i).sFileName & " -- " & the_array(i).curFileSize & " bytes" & vbNewLine txtResult.SelStart = Len(txtResult) Next End Sub ' ----------------------------------------------------------------------------------------- ' \\ -- Inicio -- Cargar lista de archivos en el array ' ----------------------------------------------------------------------------------------- Private Sub Fill_Array(sPath As String) Dim sFileName As String Dim lIndex As Long ' -- Comprobar la barra separadora del path If Right(sPath, 1) <> "\" Then sPath = sPath & "\" ' -- Buscar el primer archivo del directorio windows sFileName = Dir(sPath & "*.*", vbArchive + vbHidden + vbNormal + vbReadOnly + vbSystem) ' -- Redimensionar el array que contendrá la lista de archivos a buscar en windows ReDim the_array(0) ' -- Cambiar puntero de espera del mouse Me.MousePointer = vbHourglass ' -- Buscar ... While sFileName <> "" ' -- índice del último elemento de la matriz lIndex = UBound(the_array) ' -- Cargar los datos en array ( Tamaño y nombre) With the_array(lIndex) .curFileSize = FileLen(sPath & sFileName) .sFileName = sFileName End With ' -- redimensionar la matriz para el próximo elemento ReDim Preserve the_array(lIndex + 1) ' -- Seguir buscando mas archivos sFileName = Dir Wend ' -- Si hay mas de un archivo, entonces eliminar el último ya que es un elemento vacío If UBound(the_array) > 0 Then ReDim Preserve the_array(UBound(the_array) - 1) End If ' -- Fin Me.MousePointer = vbDefault Exit Sub error_handler: MsgBox Err.Description, vbCritical Me.MousePointer = vbDefault End Sub Private Sub Form_Load() cmdSort.Caption = "Cargar y Ordenar" End Sub

Ordenar registros de un archivo de texto

El siguiente ejemplo es similar al anterior, y lo que hace es leer un archivo de texto que contiene registros ( un CVS delimitado por comas ). Este contiene dos campos : Nombre de producto y Precio de producto.

Luego de leer los registros que se encuentran desordenados, se cargan todos ellos en un vector para poder ordenarlos con QuickSort de acuerdo al campo Precio. Por último, una vez finalizada la ordenación, se cargan los registros en un grid

Ejemplo

1 - Colocar un control Microsoft FlexGrid : MsFlexGrid1

2 - Botón : CmdSort

3 - Crear un archivo en al App.path llamado test.txt con dos campos ( Producto y precio )

El archivo contiene la siguiente estructura ( delimitado por el caracter punto y coma ) por ejemplo

Producto 1;130,65
Producto 2;76,85
Producto 3;16,35
Producto 4;98,28
Producto 5;1000,22
Producto 6;14,45
Producto 7;154,25
Producto 8;163,15
Producto 9;18,75
Producto 10;123,95
Producto 11;1,20
Producto 12;3,35
Producto 13;3,65
Producto 14;33,28
Producto 15;93,23

Código fuente

Option Explicit ' --------------------------------------------------------------------------------------- ' \\ -- Autor del ejemplo : Luciano Lodola -- http://www.recursosvisualbasic.com.ar ' \\ -- Nota. La función de ordenación está adaptada de un ejemplo creado por Randy Birch) ' --------------------------------------------------------------------------------------- ' -- UDT para los datos Private Type tData s_Nombre_Producto As String ' -- Campo para el Nombre del producto cur_Precio_Producto As Currency ' -- Campo para el precio del producto End Type ' -- Declarar matriz de datos para almacenar los registros del archivo Private the_array() As tData ' --------------------------------------------------------------------------------------- ' \\ -- Función para ordenar los registros de acuerdo al precio de cada producto ' --------------------------------------------------------------------------------------- Private Sub QuickSort(the_array() As tData, l As Currency, r As Currency) Dim i As Currency Dim j As Currency Dim X As Currency Dim Y As tData i = l j = r X = the_array((l + r) / 2).cur_Precio_Producto While (i <= j) While (the_array(i).cur_Precio_Producto < X And i < r) i = i + 1 Wend While (X < the_array(j).cur_Precio_Producto And j > l) j = j - 1 Wend If (i <= j) Then Y.cur_Precio_Producto = the_array(i).cur_Precio_Producto Y.s_Nombre_Producto = the_array(i).s_Nombre_Producto the_array(i).cur_Precio_Producto = the_array(j).cur_Precio_Producto the_array(i).s_Nombre_Producto = the_array(j).s_Nombre_Producto the_array(j).cur_Precio_Producto = Y.cur_Precio_Producto the_array(j).s_Nombre_Producto = Y.s_Nombre_Producto i = i + 1 j = j - 1 End If Wend If (l < j) Then Call QuickSort(the_array, l, j) End If If (i < r) Then Call QuickSort(the_array, i, r) End If End Sub ' ----------------------------------------------------------------------------------------- ' \\ -- Botón para comenzar la ordenación ' ----------------------------------------------------------------------------------------- Private Sub cmdSort_Click() ' -- Cargar los registros del archivo en el array If Fill_Array(App.Path & "\test.txt") Then ' -- Llamar a la función para ordenar con QuickSort Call QuickSort(the_array, LBound(the_array), UBound(the_array)) ' -- Cargar los datos ordenados en el Grid ( Microsoft Flexgrid ) Dim i As Variant With MSFlexGrid1 Call pvConfig_FlexGrid For i = LBound(the_array) To UBound(the_array) ' -- Agregar producto y precio ordenados en forma ascendente .AddItem _ CStr(the_array(i).s_Nombre_Producto) & vbTab & _ FormatCurrency(the_array(i).cur_Precio_Producto) Next End With End If End Sub ' ----------------------------------------------------------------------------------------- ' \\ Leer los registros del archivo y cargarlos en la matriz para poder ordenarlos ' ----------------------------------------------------------------------------------------- Private Function Fill_Array(sFileName As String) As Boolean On Error GoTo error_handler Dim nFileNumber As Integer Dim lIndex As Long Dim sLine As String Dim arrLine() As String ' -- Buscar un número de archivo libre nFileNumber = FreeFile Open sFileName For Input As #nFileNumber ' -- Redimensionar el array que contendrá la lista de archivos a buscar en windows ReDim the_array(0) ' -- Cambiar puntero de espera del mouse Me.MousePointer = vbHourglass ' -- Buscar ... While Not EOF(nFileNumber) ' -- índice del último elemento de la matriz lIndex = UBound(the_array) Line Input #nFileNumber, sLine arrLine = Split(sLine, ";") ' -- Cargar los datos en array ( Tamaño y nombre) With the_array(lIndex) .cur_Precio_Producto = CCur(arrLine(1)) .s_Nombre_Producto = arrLine(0) End With ' -- redimensionar la matriz para el próximo elemento ReDim Preserve the_array(lIndex + 1) Wend ' -- Cerrar el archivo Close #nFileNumber ' -- Si hay mas de un archivo, entonces eliminar el último ya que es un elemento vacío If UBound(the_array) > 0 Then ReDim Preserve the_array(UBound(the_array) - 1) End If Fill_Array = True ' -- Fin Me.MousePointer = vbDefault Exit Function error_handler: MsgBox Err.Description, vbCritical Me.MousePointer = vbDefault Close End Function ' ----------------------------------------------------------------------------------------- ' \\ Configurar opciones del Grid ' ----------------------------------------------------------------------------------------- Private Sub pvConfig_FlexGrid() ' -- Configurar encabezado del Grid With MSFlexGrid1 .Clear ' -- Borrar datos previos del Grid .FixedCols = 0 .FormatString = "NombreProducto|Precio del Producto" ' -- Ancho de las columnas .ColWidth(0) = 3500 .ColWidth(1) = 2500 .Rows = 1 End With End Sub Private Sub Form_Load() Call pvConfig_FlexGrid cmdSort.Caption = "Cargar y Ordenar" End Sub

Recursos vb 6.0 - Enlaces relacionados

Recursos vb.net - Relacionados

Ordenar un array o matriz unidimensional

Buscar en Recursos vb