Sorting Algorithm VBA

Necesitaba ordenar un valor en base a una lista de fechas ordenadas descendentes. No tenia idea como hacerlos y tampoco encontraba información al respecto. Cada vez que tengo una duda que ya no puedo solucionar, le pido ayuda a mi amigo Cristian Lizana para que me de una pista y encontrar el camino correcto. Me comentó de Sorting_algorithm el cual respondía a mis necesidades.

Implementé un código para analizar un rango que selecciono en Excel.


Set rango = Application.InputBox(Prompt:="Seleccionar rango oe!!!", Title:="Seleccion de rango", Type:=8) 'Obtengo un rango seleccionado.

x = 1
For i = 1 To rango.Rows.Count 'ingreso a un array todas las fechas seleccionadas.
    If (rango.Cells(i, 2).Value = componente) Then
        ReDim Preserve arrfech(x)
        arrfech(x) = CDate(rango.Cells(i, 1).Value)
        x = x + 1
    End If
Next i

Sort ordena el array de fechas con el orden solicitado:

Do
    Changed = False
    For Pointer = 1 To (Application.CountA(arrfech) - 2)
        If CDate(arrfech(Pointer)) > CDate(arrfech(Pointer + 1)) Then
            MyTemp = arrfech(Pointer)
            arrfech(Pointer) = arrfech(Pointer + 1)
            arrfech(Pointer + 1) = MyTemp
            Changed = True
        End If
    Next
Loop While Changed = True

Comentarios

Publicar un comentario

Entradas populares de este blog

Descarga revistas yumpu.com

Imagen
Como el titulo lo dice, generé un pequeño programa que realiza descargas de las revisar publicadas en yumpu.com. Necesitaba/n un archivo que había sido subido a este portal, el brillo es que se encuentra en un ember por lo que no se puede bajar o incluso siquiera revise si se podía. De igual manera, este es el código del programa por si alguien lo quiere mejorar o bajar imágenes desde otros lados y weas. Lo que hace el programa es bajar las imágenes de cada revisar que se encuentran en una ruta especifica. Para esto se debe entregar al programa el numero de la revista que se muestra en la imagenes N° 1. También se puede ver un JSON el cual nos presenta los tamaños de las imágenes y la cantidad de archivos. Una vez descargadas las imágenes, procedemos a transformar todo en un PDF y borrar las imágenes. El programa se realizo en C# con SharpDevelop en modo consola, las librerias itextSharp y NewtonSoft Json. De no ser libres estas librerías, besitos para que me perdonen de no ser a
Leer más

XML - Download File - VBA Excel

Imagen
Tengo un archivo que es usado por distintas personas, necesito realizar una modificación a gran escala en una de las hojas. Para esto usé un archivo estándar que se encontrará online en el servidor y los archivos de las personas puedan diferenciar si tienen una versión antigua comparando el archivo estandar. Para lograr esto, en el archivo usado por el personal cree un macro que valida la versión tanto del archivo personal como del online. También se valida que tengan Internet para realizar el update. y por ultimo se valida que si no realiza la actualización, no puede usar el archivo personal. Inicio automático validación archivo personal: Sub Auto_Open() 'Ejecuta el macro cuando abrimos el archivo excel personal. GetCurrentVersionNumber End Sub Obtención de versión: Function GetCurrentVersionNumber() As String Dim doc As MSXML2.DOMDocument Dim version As String If (checkInternetConnection = True) Then 'valida conexion a internet Set
Leer más

Funciones VBA Excel

Imagen
Como comenté anteriormente, en mi trabajo no cuento mas que con Excel para desarrollos. Se me solicito generar una etiqueta dinámica en base a datos en distintas sheets(hojas). Public Sub Genera() 'Funcion principal. Dim equipo As String, modelo As String, pm As String, conca As String, faena As String, horaaceite As String, rango1 As String, rango2 As String Dim i As Integer, x As Integer, contador As Integer Dim LArray() As String equipo = Sheets.Item("DATOS MANUALES").Cells(2, 4).Value pm = Sheets.Item("DATOS MANUALES").Cells(4, 4).Value horo = Sheets.Item("DATOS MANUALES").Cells(6, 4).Value fecha = Sheets.Item("DATOS MANUALES").Cells(8, 4).Value respo = Sheets.Item("DATOS MANUALES").Cells(10, 4).Value conca = BuscaModelo(equipo) LArray = Split(conca, "/") modelo = LArray(0) faena = LArray(1) serie = LArray(2) limpiar limpiarBordes borrarImagen contador = 3 For i = 2 To 5000 imodelo = Sheet
Leer más