Ordenar datos en un combo

hola, Jorge !

... en el caso de... columnas donde los datos unicos son mas de 300 es muy, pero funciona...
... una manera de hacerlo mas rapido seria muy bueno...
... he platicado acerca de este foro y no me creen que puedan saber... y ademas compartirlo

1) 'invitalos' a que participen :))

2) el siguiente ejemplo, con un listado de 10,000 elementos de los cuales existen 300 'unicos'...
carga el listado ordenado al combobox del formulario, en 'cosa de... un suspiro' :))

-> los supuestos son:
a) los datos se toman de la columna 'D' y la celda 'D1' son titulos o encabezados [necesarios para filtro avanzado]
b) la columna 'libre' a donde se pasan los 'unicos' es la columna 'H'
la macro filtra los unicos a la columna 'H', los ordena, y los pasa 'directo' al combobox ;)

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

la fraccion del codigo en un modulo 'X' que -en su caso- utiliza a la hoja activa == [h:h].ClearContents
Range([d1], [d65536].End(xlUp)).AdvancedFilter xlFilterCopy, , [h1], True
[h2].Sort Key1:=[h2], Order1:=xlAscending, Header:=True
With UserForm1.ComboBox1
.Clear
.List = Range([h2], [h65536].End(xlUp)).Value
End With

Héctor,

1.- Los he invitado a este foro y he pasado la liga. Varios amigos me
han comentado el excelente resultado que da el apoyarnos en este foro.

2.- De hecho esto me lo pasaste hace tiempo y lo hago con 10 combos.
Así lo haré ya que es la forma mas rápida.

Muchas gracias !!!
Un saludo
Jorge cué.


Héctor Miguel ha escrito:

hola, Jorge !

> ... en el caso de... columnas donde los datos unicos son mas de 300 es muy, pero funciona...
> ... una manera de hacerlo mas rapido seria muy bueno...
> ... he platicado acerca de este foro y no me creen que puedan saber... y ademas compartirlo

1) 'invitalos' a que participen :))

2) el siguiente ejemplo, con un listado de 10,000 elementos de los cuales existen 300 'unicos'...
carga el listado ordenado al combobox del formulario, en 'cosa de... un suspiro' :))

-> los supuestos son:
a) los datos se toman de la columna 'D' y la celda 'D1' son titulos o encabezados [necesarios para filtro avanzado]
b) la columna 'libre' a donde se pasan los 'unicos' es la columna 'H'
la macro filtra los unicos a la columna 'H', los ordena, y los pasa 'directo' al combobox ;)

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

la fraccion del codigo en un modulo 'X' que -en su caso- utiliza a la hoja activa ==> [h:h].ClearContents
Range([d1], [d65536].End(xlUp)).AdvancedFilter xlFilterCopy, , [h1], True
[h2].Sort Key1:=[h2], Order1:=xlAscending, Header:=True
With UserForm1.ComboBox1
.Clear
.List = Range([h2], [h65536].End(xlUp)).Value
End With

Hola Jorge

ya he visto que al final Hector te ha ayudado con el problema, pero de todas
formas te paso el listado del metodo de ordenacion quicksort por si alguna
vez necesitas tirar de el para ordenar series de datos.

un sauldo
juan

creo que te he mandado una copia a tu correo.

= codigo

Dim datos(1 To 1000) As Long

Sub NumAl3()
Dim i As Long
Dim n As Long
Dim inicio As Single, final As Single

Application.ScreenUpdating = False
inicio = Timer
Randomize
n = 1000

For i = 1 To n
datos(i) = Int((10000 * Rnd) + 1)
Next i
For i = 1 To n
Cells(2 + i, 2) = datos(i)
Next i
Call OrdRapida(1, n)

For i = 1 To n
Cells(2 + i, 3) = datos(i)
Next i

final = Timer
Application.ScreenUpdating = True
MsgBox "tiempo transcurrido " & final - inicio

End Sub

Sub Intercambiar(X As Long, Y As Long)
Dim aux As Long
aux = X
X = Y
Y = aux
End Sub

Sub Dividir(Primero As Long, _
Ultimo As Long, PuntoDivision As Long)

Dim Derecha As Long, Izquierda As Long
Dim V As Long

V = datos(Primero)
Derecha = Primero + 1
Izquierda = Ultimo
Do
Do While (Derecha < Izquierda) _
And (datos(Derecha) <= V)
Derecha = Derecha + 1
Loop
If (Derecha = Izquierda) _
And (datos(Derecha)) <= V Then
Derecha = Derecha + 1
End If
Do While (Derecha <= Izquierda) _
And (datos(Izquierda) >= V)
Izquierda = Izquierda - 1
Loop
If Derecha < Izquierda Then
Call Intercambiar(datos(Derecha), datos(Izquierda))
Derecha = Derecha + 1
Izquierda = Izquierda - 1
End If
Loop Until Derecha > Izquierda
Call Intercambiar(datos(Primero), datos(Izquierda))
PuntoDivision = Izquierda
End Sub

Sub OrdRapida(Primero As Long, _
Ultimo As Long)

Dim PuntoDivision As Long

If Primero < Ultimo Then
Call Dividir(Primero, Ultimo, PuntoDivision)
Call OrdRapida(Primero, PuntoDivision - 1)
Call OrdRapida(PuntoDivision + 1, Ultimo)
End If
End Sub

Juan,

Muchas gracias por tu apoyo !!!
Un saludo.
Jorge.


Juan ha escrito:

Hola Jorge

ya he visto que al final Hector te ha ayudado con el problema, pero de todas
formas te paso el listado del metodo de ordenacion quicksort por si alguna
vez necesitas tirar de el para ordenar series de datos.

un sauldo
juan

creo que te he mandado una copia a tu correo.

= codigo

Dim datos(1 To 1000) As Long

Sub NumAl3()
Dim i As Long
Dim n As Long
Dim inicio As Single, final As Single

Application.ScreenUpdating = False
inicio = Timer
Randomize
n = 1000

For i = 1 To n
datos(i) = Int((10000 * Rnd) + 1)
Next i
For i = 1 To n
Cells(2 + i, 2) = datos(i)
Next i
Call OrdRapida(1, n)

For i = 1 To n
Cells(2 + i, 3) = datos(i)
Next i

final = Timer
Application.ScreenUpdating = True
MsgBox "tiempo transcurrido " & final - inicio

End Sub

Sub Intercambiar(X As Long, Y As Long)
Dim aux As Long
aux = X
X = Y
Y = aux
End Sub

Sub Dividir(Primero As Long, _
Ultimo As Long, PuntoDivision As Long)

Dim Derecha As Long, Izquierda As Long
Dim V As Long

V = datos(Primero)
Derecha = Primero + 1
Izquierda = Ultimo
Do
Do While (Derecha < Izquierda) _
And (datos(Derecha) <= V)
Derecha = Derecha + 1
Loop
If (Derecha = Izquierda) _
And (datos(Derecha)) <= V Then
Derecha = Derecha + 1
End If
Do While (Derecha <= Izquierda) _
And (datos(Izquierda) >= V)
Izquierda = Izquierda - 1
Loop
If Derecha < Izquierda Then
Call Intercambiar(datos(Derecha), datos(Izquierda))
Derecha = Derecha + 1
Izquierda = Izquierda - 1
End If
Loop Until Derecha > Izquierda
Call Intercambiar(datos(Primero), datos(Izquierda))
PuntoDivision = Izquierda
End Sub

Sub OrdRapida(Primero As Long, _
Ultimo As Long)

Dim PuntoDivision As Long

If Primero < Ultimo Then
Call Dividir(Primero, Ultimo, PuntoDivision)
Call OrdRapida(Primero, PuntoDivision - 1)
Call OrdRapida(PuntoDivision + 1, Ultimo)
End If
End Sub

Juan,

No se donde coloco este código.
Te pido de la manera mas atenta me indiques la forma de hacerlo.
Muchas gracias.
Un saludo.
Jorge


ha escrito:

Juan,

Muchas gracias por tu apoyo !!!
Un saludo.
Jorge.


Juan ha escrito:

> Hola Jorge
>
> ya he visto que al final Hector te ha ayudado con el problema, pero de todas
> formas te paso el listado del metodo de ordenacion quicksort por si alguna
> vez necesitas tirar de el para ordenar series de datos.
>
> un sauldo
> juan
>
> creo que te he mandado una copia a tu correo.
>
> = codigo
>
> Dim datos(1 To 1000) As Long
>
> Sub NumAl3()
> Dim i As Long
> Dim n As Long
> Dim inicio As Single, final As Single
>
> Application.ScreenUpdating = False
> inicio = Timer
> Randomize
> n = 1000
>
> For i = 1 To n
> datos(i) = Int((10000 * Rnd) + 1)
> Next i
> For i = 1 To n
> Cells(2 + i, 2) = datos(i)
> Next i
> Call OrdRapida(1, n)
>
> For i = 1 To n
> Cells(2 + i, 3) = datos(i)
> Next i
>
> final = Timer
> Application.ScreenUpdating = True
> MsgBox "tiempo transcurrido " & final - inicio
>
> End Sub
>
> Sub Intercambiar(X As Long, Y As Long)
> Dim aux As Long
> aux = X
> X = Y
> Y = aux
> End Sub
>
> Sub Dividir(Primero As Long, _
> Ultimo As Long, PuntoDivision As Long)
>
> Dim Derecha As Long, Izquierda As Long
> Dim V As Long
>
> V = datos(Primero)
> Derecha = Primero + 1
> Izquierda = Ultimo
> Do
> Do While (Derecha < Izquierda) _
> And (datos(Derecha) <= V)
> Derecha = Derecha + 1
> Loop
> If (Derecha = Izquierda) _
> And (datos(Derecha)) <= V Then
> Derecha = Derecha + 1
> End If
> Do While (Derecha <= Izquierda) _
> And (datos(Izquierda) >= V)
> Izquierda = Izquierda - 1
> Loop
> If Derecha < Izquierda Then
> Call Intercambiar(datos(Derecha), datos(Izquierda))
> Derecha = Derecha + 1
> Izquierda = Izquierda - 1
> End If
> Loop Until Derecha > Izquierda
> Call Intercambiar(datos(Primero), datos(Izquierda))
> PuntoDivision = Izquierda
> End Sub
>
> Sub OrdRapida(Primero As Long, _
> Ultimo As Long)
>
> Dim PuntoDivision As Long
>
> If Primero < Ultimo Then
> Call Dividir(Primero, Ultimo, PuntoDivision)
> Call OrdRapida(Primero, PuntoDivision - 1)
> Call OrdRapida(PuntoDivision + 1, Ultimo)
> End If
> End Sub