Ordenar listbox por fecha macro
Tengo un problema he buscado pero no encuentro como ordenar un listbox!
Tengo lo siguiente un listbox con 8 columnas en la cual en la columna 4 me muestra fechas
¿La pregunta seria se puede ordenar en forma descendiente por esa columna que tiene fecha? ¿Con un boton?
1 Respuesta

H o l a:
¿Puedes poner las instrucciones que utilizas para cargar los datos al listbox?
Y cómo está la fecha cargada, por ejemplo dd/mm/aaaa?

Gracias Dan por responder...
este es el codigo que se llena al cambiar el combobox la fecha esta con este formato DD-MM-YYYY
Private Sub ComboBoxCodigo_Reb_Change() Application.ScreenUpdating = False 'On Error Resume Next 'ComboBoxLote_Reb_Change Me.ListBox2.Clear Dim myrange As Range, i As Integer, Celdi As Range, NameCeldi i = Sheets("Registros").Range("A" & Rows.Count).End(xlUp).Row Set myrange = Sheets("Registros").Range("A2:A" & i) ComboBoxLote_Reb.Clear Set Celdi = myrange.Find(What:=ComboBoxCodigo_Reb.Text) If Not Celdi Is Nothing Then NameCeldi = Celdi.Address Do If Cells(Celdi.Row, "G") > 0 Then dato = Sheets("Registros").Range("B" & Celdi.Row) With ComboBoxLote_Reb existe = False For i = 0 To .ListCount - 1 Select Case StrComp(.List(i), dato, vbTextCompare) Case 0 existe = True Exit For 'ya existe en el combo y ya no lo agrega Case 1 .AddItem dato, i .Column(1, .ListCount - 1) = Celdi.Row existe = True Exit For 'Es menor, lo agrega antes del comparado End Select Next If existe = False Then .AddItem dato 'Es mayor lo agrega al final .Column(1, .ListCount - 1) = Celdi.Row End If End With End If Set Celdi = myrange.FindNext(Celdi) Loop While Not Celdi Is Nothing And Celdi.Address <> NameCeldi End If If ComboBoxLote_Reb.ListCount > 0 Then With ComboBoxLote_Reb .Visible = True .ListIndex = 0 End With End If Application.ScreenUpdating = True ListBox2.Clear ListBox2.ColumnCount = 8 ListBox2.ColumnWidths = "100;100;100;100;100;1;1;1" For i = 2 To Hoja4.Range("A" & Rows.Count).End(xlUp).Row cadena = UCase(Hoja4.Cells(i, 1)) If cadena Like "*" & UCase(ComboBoxCodigo_Reb) & "*" And Hoja4.Cells(i, "G") <> 0 Then existe = False For j = 0 To ListBox2.ListCount - 1 If IsNumeric(ListBox2.List(j)) Then vmate = CDbl(ListBox2.List(j)) Else vmate = ListBox2.List(j) If IsNumeric(ListBox2.List(j, 1)) Then vlote = CDbl(ListBox2.List(j, 1)) Else vlote = ListBox2.List(j, 1) ' If vmate = Hoja4.Cells(i, "A") And vlote = Hoja4.Cells(i, "B") Then ListBox2.List(j, 3) = Format(CDbl(ListBox2.List(j, 3)) + Hoja4.Cells(i, "G"), "#0.000") existe = True Exit For End If Next If existe = False Then agrega i, Hoja4 End If Next ' For i = 0 To ListBox2.ListCount - 1 If ListBox2.List(i, 1) = ComboBoxLote_Reb Then LabelCantidad_Reb = ListBox2.List(i, 3) LabelUM_Reb = ListBox2.List(i, 2) LabelTextoBreve_Reb = ListBox2.List(i, 6) TextBoxDescripcion_Reb = ListBox2.List(i, 7) LabelLote = ListBox2.List(i, 1) Exit For End If Next End Sub
Sub agrega(i, Hoja4) ListBox2.AddItem Hoja4.Cells(i, "A") ListBox2.List(ListBox2.ListCount - 1, 1) = Hoja4.Cells(i, "B") ListBox2.List(ListBox2.ListCount - 1, 2) = Hoja4.Cells(i, "I") ListBox2.List(ListBox2.ListCount - 1, 3) = Format(Hoja4.Cells(i, "G"), "#0.000") ListBox2.List(ListBox2.ListCount - 1, 4) = Format(Hoja4.Cells(i, "D"), "DD-MM-YYYY") ListBox2.List(ListBox2.ListCount - 1, 5) = Hoja4.Cells(i, "N") ListBox2.List(ListBox2.ListCount - 1, 6) = Hoja4.Cells(i, "H") ListBox2.List(ListBox2.ListCount - 1, 7) = Hoja4.Cells(i, "K") End Sub

H o l a:
Quedaría así, antes debes crear una hoja llamada "temp" para utilizar para ordenar las fechas.
Private Sub ComboBoxCodigo_Reb_Change() Application.ScreenUpdating = False 'On Error Resume Next Me.ListBox2.Clear Dim myrange As Range, i As Integer, Celdi As Range, NameCeldi i = Sheets("Registros").Range("A" & Rows.Count).End(xlUp).Row Set myrange = Sheets("Registros").Range("A2:A" & i) ComboBoxLote_Reb.Clear Set Celdi = myrange.Find(What:=ComboBoxCodigo_Reb.Text) If Not Celdi Is Nothing Then NameCeldi = Celdi.Address Do If Cells(Celdi.Row, "G") > 0 Then dato = Sheets("Registros").Range("B" & Celdi.Row) With ComboBoxLote_Reb existe = False For i = 0 To .ListCount - 1 Select Case StrComp(.List(i), dato, vbTextCompare) Case 0 existe = True Exit For 'ya existe en el combo y ya no lo agrega Case 1 .AddItem dato, i .Column(1, .ListCount - 1) = Celdi.Row existe = True Exit For 'Es menor, lo agrega antes del comparado End Select Next If existe = False Then .AddItem dato 'Es mayor lo agrega al final .Column(1, .ListCount - 1) = Celdi.Row End If End With End If Set Celdi = myrange.FindNext(Celdi) Loop While Not Celdi Is Nothing And Celdi.Address <> NameCeldi End If If ComboBoxLote_Reb.ListCount > 0 Then With ComboBoxLote_Reb .Visible = True .ListIndex = 0 End With End If Application.ScreenUpdating = True ' Set h1 = Sheets("temp") h1.Cells.Clear k = 1 ListBox2.Clear ListBox2.ColumnCount = 8 ListBox2.ColumnWidths = "100;100;100;100;100;1;1;1" For i = 2 To Hoja4.Range("A" & Rows.Count).End(xlUp).Row cadena = UCase(Hoja4.Cells(i, 1)) If cadena Like "*" & UCase(ComboBoxCodigo_Reb) & "*" And Hoja4.Cells(i, "G") <> 0 Then existe = False For j = 0 To ListBox2.ListCount - 1 If IsNumeric(ListBox2.List(j)) Then vmate = CDbl(ListBox2.List(j)) Else vmate = ListBox2.List(j) If IsNumeric(ListBox2.List(j, 1)) Then vlote = CDbl(ListBox2.List(j, 1)) Else vlote = ListBox2.List(j, 1) ' If vmate = Hoja4.Cells(i, "A") And vlote = Hoja4.Cells(i, "B") Then ListBox2.List(j, 3) = Format(CDbl(ListBox2.List(j, 3)) + Hoja4.Cells(i, "G"), "#0.000") existe = True Exit For End If Next If existe = False Then 'agrega i, Hoja4 h1.Cells(k, "A") = Hoja4.Cells(i, "A") h1.Cells(k, "B") = Hoja4.Cells(i, "B") h1.Cells(k, "I") = Hoja4.Cells(i, "I") h1.Cells(k, "G") = Hoja4.Cells(i, "G") h1.Cells(k, "D") = Hoja4.Cells(i, "D") h1.Cells(k, "N") = Hoja4.Cells(i, "N") h1.Cells(k, "H") = Hoja4.Cells(i, "H") h1.Cells(k, "K") = Hoja4.Cells(i, "K") k = k + 1 End If End If Next ' 'Ordena por fecha u = h1.Range("A" & Rows.Count).End(xlUp).Row With h1.Sort .SortFields.Clear .SortFields.Add Key:=h1.Range("D1:D" & u), _ SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal .SetRange h1.Range("A1:N" & u) .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With For i = 1 To u agrega i, Hoja1 Next ' For i = 0 To ListBox2.ListCount - 1 If ListBox2.List(i, 1) = ComboBoxLote_Reb Then LabelCantidad_Reb = ListBox2.List(i, 3) LabelUM_Reb = ListBox2.List(i, 2) LabelTextoBreve_Reb = ListBox2.List(i, 6) TextBoxDescripcion_Reb = ListBox2.List(i, 7) LabelLote = ListBox2.List(i, 1) Exit For End If Next End Sub ' Sub agrega(i, h1) ListBox2. AddItem Hoja1.Cells(i, "A") ListBox2. List(ListBox2.ListCount - 1, 1) = h1.Cells(i, "B") ListBox2. List(ListBox2.ListCount - 1, 2) = h1.Cells(i, "I") ListBox2.List(ListBox2.ListCount - 1, 3) = Format(h1.Cells(i, "G"), "#0.000") ListBox2. List(ListBox2.ListCount - 1, 4) = Format(h1. Cells(i, "D"), "DD-MM-YYYY") ListBox2. List(ListBox2.ListCount - 1, 5) = h1.Cells(i, "N") ListBox2. List(ListBox2.ListCount - 1, 6) = h1.Cells(i, "H") ListBox2. List(ListBox2.ListCount - 1, 7) = h1.Cells(i, "K") End Sub
':) 'S aludos. D a n t e A m o r . R ecuerda valorar la respuesta. G racias ':)

Dan...
El orden lo hace bien pero me esta afectando los resultados del listbox...
Ejemplo
El código busca por la columna A y B si son iguales suma los valores de la columna G y los muestra solo una vez en el listbox, pero con la adaptación que Ud le hizo para ordenar no me esta sumando los valores... los muestra por separado...

Van los cambios
Private Sub ComboBoxCodigo_Reb_Change() Application.ScreenUpdating = False 'On Error Resume Next Me.ListBox2.Clear Dim myrange As Range, i As Integer, Celdi As Range, NameCeldi i = Sheets("Registros").Range("A" & Rows.Count).End(xlUp).Row Set myrange = Sheets("Registros").Range("A2:A" & i) ComboBoxLote_Reb.Clear Set Celdi = myrange.Find(What:=ComboBoxCodigo_Reb.Text, lookat:=xlWhole) If Not Celdi Is Nothing Then NameCeldi = Celdi.Address Do If Cells(Celdi.Row, "G") > 0 Then dato = Sheets("Registros").Range("B" & Celdi.Row) With ComboBoxLote_Reb existe = False For i = 0 To .ListCount - 1 Select Case StrComp(.List(i), dato, vbTextCompare) Case 0 existe = True Exit For 'ya existe en el combo y ya no lo agrega Case 1 .AddItem dato, i .Column(1, .ListCount - 1) = Celdi.Row existe = True Exit For 'Es menor, lo agrega antes del comparado End Select Next If existe = False Then .AddItem dato 'Es mayor lo agrega al final .Column(1, .ListCount - 1) = Celdi.Row End If End With End If Set Celdi = myrange.FindNext(Celdi) Loop While Not Celdi Is Nothing And Celdi.Address <> NameCeldi End If If ComboBoxLote_Reb.ListCount > 0 Then With ComboBoxLote_Reb .Visible = True .ListIndex = 0 End With End If Application.ScreenUpdating = True ' Set h1 = Sheets("temp") h1.Cells.Clear k = 1 ListBox2.Clear ListBox2.ColumnCount = 8 ListBox2.ColumnWidths = "100;100;100;100;100;100;100;100" For i = 2 To Hoja4.Range("A" & Rows.Count).End(xlUp).Row cadena = UCase(Hoja4.Cells(i, 1)) If cadena Like "*" & UCase(ComboBoxCodigo_Reb) & "*" And Hoja4.Cells(i, "G") <> 0 Then existe = False 'For j = 0 To ListBox2.ListCount - 1 For j = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row If IsNumeric(h1.Cells(j, "A")) Then vmate = CDbl(h1.Cells(j, "A")) Else vmate = h1.Cells(j, "A") If IsNumeric(h1.Cells(j, "B")) Then vlote = CDbl(h1.Cells(j, "B")) Else vlote = h1.Cells(j, "B") ' If vmate = Hoja4.Cells(i, "A") And vlote = Hoja4.Cells(i, "B") Then h1.Cells(j, "G") = h1.Cells(j, "G") + Hoja4.Cells(i, "G") existe = True Exit For End If Next If existe = False Then 'agrega i, Hoja4 h1.Cells(k, "A") = Hoja4.Cells(i, "A") h1.Cells(k, "B") = Hoja4.Cells(i, "B") h1.Cells(k, "I") = Hoja4.Cells(i, "I") h1.Cells(k, "G") = Hoja4.Cells(i, "G") h1.Cells(k, "D") = Hoja4.Cells(i, "D") h1.Cells(k, "N") = Hoja4.Cells(i, "N") h1.Cells(k, "H") = Hoja4.Cells(i, "H") h1.Cells(k, "K") = Hoja4.Cells(i, "K") k = k + 1 End If End If Next ' 'Ordena por fecha u = h1.Range("A" & Rows.Count).End(xlUp).Row With h1.Sort .SortFields.Clear .SortFields.Add Key:=h1.Range("D1:D" & u), _ SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal .SetRange h1.Range("A1:N" & u) .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With For i = 1 To u agrega i, h1 Next ' For i = 0 To ListBox2.ListCount - 1 If ListBox2.List(i, 1) = ComboBoxLote_Reb Then LabelCantidad_Reb = ListBox2.List(i, 3) LabelUM_Reb = ListBox2.List(i, 2) LabelTextoBreve_Reb = ListBox2.List(i, 6) TextBoxDescripcion_Reb = ListBox2.List(i, 7) LabelLote = ListBox2.List(i, 1) Exit For End If Next End Sub ' Sub agrega(i, h1) ListBox2. AddItem Hoja1.Cells(i, "A") ListBox2. List(ListBox2.ListCount - 1, 1) = h1.Cells(i, "B") ListBox2. List(ListBox2.ListCount - 1, 2) = h1.Cells(i, "I") ListBox2.List(ListBox2.ListCount - 1, 3) = Format(h1.Cells(i, "G"), "#0.000") ListBox2. List(ListBox2.ListCount - 1, 4) = Format(h1. Cells(i, "D"), "DD-MM-YYYY") ListBox2. List(ListBox2.ListCount - 1, 5) = h1.Cells(i, "N") ListBox2. List(ListBox2.ListCount - 1, 6) = h1.Cells(i, "H") ListBox2. List(ListBox2.ListCount - 1, 7) = h1.Cells(i, "K") End Sub
':) 'S aludos. D a n t e A m o r . R ecuerda valorar la respuesta. G racias ':)
- Compartir respuesta
