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
Respuesta de Dante Amor
1
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 SubSub 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 ':)
