Saltar al contenido

Ordenar listBox ¿?


Recommended Posts

publicado

Hola a todos;

En un formulario cargo manualmente los datos de en el ListBox.

Tengo un botón que me sirve para añadir registros a este ListBox

Los registros son fechas.

Entonces la pregunta es,  ¿si yo añado un nuevo registro  hay posibilidad de que se ordenen los items  por fecha?

Imagino que me la solución que me vais a dar pasará por pasar los datos a la hoja y ordenarlos desde ahí. 

Esta opción para el caso no me serviría.

Buenos días a todos.

image.thumb.png.0f1059a1caaa497043c30b16b86f499b.png

MOrdenarList.xlsm

publicado

Hola Antoni;

-Excelente propuesta, no veía muy factible que se pudiese hacer tal y como lo planteé.

Solo se me ocurren dos frases:

"Me he equivocado y no volverá a ocurrir" "Eres el MacGyver de Excel"

Un abrazo Antoni,  sigue así y aprobarás el curso de Excel??

 

publicado

Algo más corto:

Private Sub btnAñadir_Click()
Dim x As Integer, Festivos()
If Not IsDate(txtAñadirFestivo) Then
   MsgBox "Fecha errónea", vbCritical
   Exit Sub
End If
'---------------
'Añadir ordenado
With ListBox1
.AddItem
For x = .ListCount - 2 To 0 Step -1
   If CDate(.List(x)) < CDate(txtAñadirFestivo) Then Exit For
   .List(x + 1) = .List(x)
Next
.List(x) = txtAñadirFestivo
End With
End Sub

 

publicado
hace 12 minutos , Antoni dijo:

Algo más corto:

Private Sub btnAñadir_Click()
Dim x As Integer, Festivos()
If Not IsDate(txtAñadirFestivo) Then
   MsgBox "Fecha errónea", vbCritical
   Exit Sub
End If
'---------------
'Añadir ordenado
With ListBox1
.AddItem
For x = .ListCount - 2 To 0 Step -1
   If CDate(.List(x)) < CDate(txtAñadirFestivo) Then Exit For
   .List(x + 1) = .List(x)
Next
.List(x) = txtAñadirFestivo
End With
End Sub

 

 

hace 12 minutos , Antoni dijo:

Algo más corto:

Private Sub btnAñadir_Click()
Dim x As Integer, Festivos()
If Not IsDate(txtAñadirFestivo) Then
   MsgBox "Fecha errónea", vbCritical
   Exit Sub
End If
'---------------
'Añadir ordenado
With ListBox1
.AddItem
For x = .ListCount - 2 To 0 Step -1
   If CDate(.List(x)) < CDate(txtAñadirFestivo) Then Exit For
   .List(x + 1) = .List(x)
Next
.List(x) = txtAñadirFestivo
End With
End Sub

 

Si bueno es el primero buenísimo el segundo. 

Dos brillantes opciones.

Esto si que es un 2x1 y no las ofertas del Carrefour. 

No hay más  preguntas ??

 

publicado
Hace 1 hora, Antoni dijo:

Hay un error en el código del post anterior, debe ser:

.List(x + 1) = txtAñadirFestivo '<---------------

 

Sólo me había dado tiempo ha hacer una prueba y me ordenó bien.

Mañana lo compruebo y corrijo.

publicado

@AntoniNo te preocupes, maestro. A Mac Gyver en algunos capítulos tampoco le salía todo bien a la primera ?

Si algún día descubres cómo poder ordenar todos los elementos a la vez, compártelo....

Cuídate!!

Tese

publicado
hace 14 horas, Antoni dijo:

Hay un error en el código del post anterior, debe ser:

.List(x + 1) = txtAñadirFestivo '<---------------

 

Hola Antoni, he probado a modificar lo que me dices  pero para que funcione bien tengo que comentar la línea que esta después del Next.

        With ListBox1
        .AddItem
        For x = .ListCount - 2 To 0 Step -1
           If CDate(.List(x)) < CDate(txtAñadirFestivo) Then Exit For
           .List(x + 1) = .List(x)
            .List(x) = txtAñadirFestivo
        Next
'        .List(x) = txtAñadirFestivo '<----He comentado esto para que funcione
        End With

Si no comento la línea el resultado no es correcto.

¿Sería correcto así?

 

image.png

publicado

Quizás no me expliqué lo suficiente:

Private Sub btnAñadir_Click()
Dim x As Integer, Festivos()
If Not IsDate(txtAñadirFestivo) Then
   MsgBox "Fecha errónea", vbCritical
   Exit Sub
End If
With ListBox1
.AddItem
For x = .ListCount - 2 To 0 Step -1
   If CDate(.List(x)) < CDate(txtAñadirFestivo) Then Exit For
   .List(x + 1) = .List(x)
Next
.List(x + 1) = txtAñadirFestivo '<---------------
End With
End Sub

 

publicado
hace 32 minutos , Antoni dijo:

Quizás no me expliqué lo suficiente:

Private Sub btnAñadir_Click()
Dim x As Integer, Festivos()
If Not IsDate(txtAñadirFestivo) Then
   MsgBox "Fecha errónea", vbCritical
   Exit Sub
End If
With ListBox1
.AddItem
For x = .ListCount - 2 To 0 Step -1
   If CDate(.List(x)) < CDate(txtAñadirFestivo) Then Exit For
   .List(x + 1) = .List(x)
Next
.List(x + 1) = txtAñadirFestivo '<---------------
End With
End Sub

 

Ahora perfecto, disculpa .

Si no  volvemos a coincidir desearte una Feliz Navidad ou Noiteboa.??

A ver si este año recibes algo más que carbón.

Yo ya estoy pensando en empezar a exportar ?

publicado

Buenas a todos y perdón por estas horas intempestivas en plena Nochebuena...jejeje

He dado con un truquito para poder ordenar todo un listbox a la vez, en este caso con datos de fechas, pero con pequeñas modificaciones se podría hacer con cualquier tipo de datos, o eso al menos es lo que pienso yo en mi bendita ignorancia.

No es que haya descubierto la piedra filosofal, pero al usuario le parecerá que realmente se ha ordenado el listbox.

En fin, me parecía un aporte divertido y quizás pueda servir para suplir esa dificultad de ordenar dentro de ese tipo de control.

Ya me diréis, @Antoni@Sergio@Benito Bartolomé

Un saludo,

Tese

ORDENAR LISTBOX.xlsm

publicado
hace 24 minutos , Antoni dijo:

EL último bucle para copiar el ListBox2 al ListBox1, se podría sustituir por:

ListBox1.List = ListBox2.List

 

Profundizando un poco más en el método de utilizar un listbox de apoyo, la cosa podría quedar así:

Private Sub CommandButton1_Click()
   With Me.ListBox1
      Do Until .ListCount = 0
         Mayor = 0
         For i = 0 To .ListCount - 1
            If Mayor < CDate(.List(i)) Then
              Mayor = CDate(.List(i))
              Elimina = i
            End If
         Next i
         ListBox2.AddItem Mayor
         .RemoveItem Elimina
      Loop
      .List = ListBox2.List
      ListBox2.Clear
   End With
End Sub

 

publicado

Buenas, @Antoni

¿Ves por qué los autodidactas tenemos nuestras limitaciones? jejejeje

Mucho más elegante y sencillo lo tuyo. Incluir en el código todo eso de "pasado" era porque no sabía muy bien cómo eliminar el item que había pasado al Listbox2 y se me ocurrió ese "atajo".

Obviamente tampoco conocía que con

hace 44 minutos , Antoni dijo:
ListBox1.List = ListBox2.List

podía pasar todos los datos de uno a otro. Los bucles dan mucho juego pero cuando sobran, sobran....jejeje

En fin, al menos espero haber aportado la semilla para que después tu sabiduría la haya mejorado.

Saludos,

Tese

publicado
hace 19 horas, tese1969 dijo:

Buenas, @Antoni

¿Ves por qué los autodidactas tenemos nuestras limitaciones? jejejeje

Mucho más elegante y sencillo lo tuyo. Incluir en el código todo eso de "pasado" era porque no sabía muy bien cómo eliminar el item que había pasado al Listbox2 y se me ocurrió ese "atajo".

Obviamente tampoco conocía que con

podía pasar todos los datos de uno a otro. Los bucles dan mucho juego pero cuando sobran, sobran....jejeje

En fin, al menos espero haber aportado la semilla para que después tu sabiduría la haya mejorado.

Saludos,

Tese

Hola @tese1969 tú ejemplo está muy bien.

En el caso que planteé quería evitar cargar los datos desde una hoja aún así te agradezco el detalle.

Estoy terminando de desarrollar un procedimiento para cargar datos  en un combobox sin usar hoja, módulo ni carga manual, es decir en un combobox vacío yo voy agregando los ítems y estos van quedando almacenados y repito no los guardo en ninguna parte del libro.

En breve os lo mostraré. 

Saludos y buen día 

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • No
      • Ni me he fijado en ellos

  • Current Donation Goals

    • Raised 0.00 EUR of 130.00 EUR target
  • Archivos

  • Estadísticas de descargas

    • Archivos
      188
    • Comentarios
      98
    • Revisiones
      29

    Más información sobre "Cambios en el Control Horario"
    Última descarga
    Por pegones1

    4    1

  • Crear macros Excel

  • Mensajes

    • Hola, veo que tienes 365, así que esta forma funcionará   Almacen.xlsx
    • Buenos días  @LeandroA espero estes bien Tengo un caso idéntico al planteado en la siguiente pregunta: Sin embargo, a diferencia de quien planteo originalmente la pregunta al correr el código no obtengo ningún resultado podrían ayudarme a resolver este inconveniente y que al hacer click en el Botón Guardar (CommandButton3) del Formulario RCS (frmrcs) el archivo pdf quede configurado con orientación vertical, márgenes superior, inferior, derecho e izquierdo = 1 y en página tamaño carta. Si acaso influye uso Microsoft Excel LTSC MSO (versión 2209 Compilación16.0.1.15629.20200) de 64 bits Mucho le sabre agradecer la ayuda que me pueda dar  RCS PRUEBA - copia.xlsm
    • @JSDJSDCon gusto mi estimado Para la opción 1: Sub Surtirhastadondealcanse() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 4 Dim filaFin As Integer: filaFin = 7 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Else solicitudes(i) = 0 End If surtido(i) = "POR FALTA STOCK" Next i ' Surtir de acuerdo al inventario disponible For i = 1 To numClientes If solicitudes(i) > 0 Then If inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) ElseIf inventario > 0 Then surtido(i) = inventario totalSurtido = totalSurtido + inventario inventario = 0 Else surtido(i) = "POR FALTA STOCK" End If End If Next i ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = "POR FALTA STOCK" Then .Value = surtido(i) .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Para la opción 2:   Sub surtirenpartesiguales() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 13 Dim filaFin As Integer: filaFin = 16 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 Dim totalPedido As Double: totalPedido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) totalPedido = totalPedido + solicitudes(i) Else solicitudes(i) = 0 End If surtido(i) = 0 Next i ' Si hay suficiente inventario, surtir lo que el cliente pide If inventario >= totalPedido Then For i = 1 To numClientes If solicitudes(i) > 0 And inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) End If Next i Else ' Reparto base igualitario Dim baseSurtido As Long baseSurtido = Int(inventario / numClientes) For i = 1 To numClientes If solicitudes(i) > 0 Then If solicitudes(i) <= baseSurtido Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) Else surtido(i) = baseSurtido inventario = inventario - baseSurtido totalSurtido = totalSurtido + baseSurtido End If End If Next i ' Repartir sobrante restante uno por uno, respetando lo pedido Do While inventario > 0 For i = 1 To numClientes If surtido(i) < solicitudes(i) Then surtido(i) = surtido(i) + 1 totalSurtido = totalSurtido + 1 inventario = inventario - 1 If inventario = 0 Then Exit For End If Next i Loop End If ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = 0 Then .Value = "POR FALTA STOCK" .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Saludos, Diego
    • Buenos dias.  Estoy trabajando en una hoja para poder llevar un control de un pequeño almacén.  Tengo un pedido con varias líneas y "lotes" y necesito sacar las ubicaciones que coincidan con la referencia y lote que pone en el pedido. El problema viene cuando tengo la misma referencia y mismo lote en ubicaciones diferentes y necesito sacar la información en columnas diferentes. No se si  me he explicado bien, pero creo que con el ejemplo adjunto se entiende mejor. Agradecería mucho si me pudieran ayudar  Libro1.xlsx
    • Exelente solución mil gracias 
  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.