Macro ordene de acuerdo dos ultimas cifras

Necesito una macro que de acuerdo a una lista de números de una columna saque otra lista de números de acuerdo a sus dos ultimas cifras en orden de 00 al 99

1 respuesta

Respuesta
1

H o  l a:

Te anexo la macro, cambia "B1:D9" por el rango de celdas que contiene la lista de números. La macro te pondrá en automático la lista ordenada 2 columnas a la derecha.

Nota: Observa como al principio de la macro van declarada la variable: valores

La macro que debes ejecutar es: Ordenar2UltimasCifras

Dim valores As New Collection
Sub Ordenar2UltimasCifras()
'Por Dante Amor
    '
    Set valores = Nothing
    Set r = Range("B1:D9")
    cfin = r.Columns.Count + r.Cells(1, 1).Column + 1
    Columns(cfin).ClearContents
    For Each c In r
        Call Agregar(c)
    Next
    '
    For i = valores.Count To 1 Step -1
        j = j + 1
        Cells(j, cfin) = valores(i)
    Next
    Set r = Nothing
    Set valores = Nothing
End Sub
'
Sub Agregar(valor)
'por.Dante Amor
    For i = 1 To valores.Count
        If Val(Right(valores(i), 2)) < Val(Right(valor, 2)) Then
            valores.Add valor, Before:=i
            Exit Sub
        End If
    Next
    valores.Add valor
End Sub

:)
S aludos.   D a n t e   A m o r. Recuerda valorar la respuesta. G r a c i a s
;) 

o sea que tengo que colocarle a una columna la alabra valores

alabra valores y si el rango es cc1.oj109" y estoy en la hoja 14

No.

En esta línea de la macro tienes que poner el rango de celdas en donde tienes los números

Set r = Range("B1:D9")

Sería de mucha ayuda si en las preguntas pones toda la información de tu hoja, también ayudaría si pones imágenes de tu hoja, de otra forma, tendrás que completar la macro.

:)
S aludos. D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
;)

Después de que cambies el rango de celdas dentro de la macro..

Seleccionas la hoja donde tienes los números y ejecutas la macro.

:)
S aludos. D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
;)

pero ejecuto las dos macros la de valor también

En mi respuesta puse esto:

La macro que debes ejecutar es: Ordenar2UltimasCifras

Entonces solamente tienes que ejecutar la macro que se llama:

Ordenar2UltimasCifras

En mi respuesta puse esto:

La macro que debes ejecutar es: Ordenar2UltimasCifras

Solamente ejecuta la macro:

Ordenar2UltimasCifras

Pero tienes que poner todo el código que te envié en un solo módulo.

:)
S aludos. D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
;)

no se ha definido sub o function cuando le doy ejecutar cambiando el rango "CC1:OJ109" le doy ejecutar a la macro ordenar dos ultimas cifras y cuando ejecuto las dos macros como la anterior y la de valor el programa no responde

cuando solo ejecuto la macro Ordenar2UltimasCifras me sale un cuadro de dialogo diciendo que no se ha definido sub  function

Sub Ordenar()


Set valores = Nothing
Set r = Range("CC1:OJ109")
cfin = r.Columns.Count + r.Cells(1, 1).Column + 1
Columns(cfin).ClearContents
For Each c In r
Call Agregar(c)
Next
'
For i = valores.Count To 1 Step -1
j = j + 1
Cells(j, cfin) = valores(i)
Next
Set r = Nothing
Set valores = Nothing
End Sub

También en mi respuesta puse esto:

Pero tienes que poner todo el código que te envié en un solo módulo.

Te anexo nuevamente todo el código, tienes que copiar todo y pegarlo dentro de un módulo, revisa que copies desde la primera línea hasta la última línea del código.

Dim valores As New Collection
Sub Ordenar2UltimasCifras()
'Por Dante Amor
    '
    Set valores = Nothing
    Set r = Range("B1:D9")
    cfin = r.Columns.Count + r.Cells(1, 1).Column + 1
    Columns(cfin).ClearContents
    For Each c In r
        Call Agregar(c)
    Next
    '
    For i = valores.Count To 1 Step -1
        j = j + 1
        Cells(j, cfin) = valores(i)
    Next
    Set r = Nothing
    Set valores = Nothing
End Sub
'
Sub Agregar(valor)
'por.Dante Amor
    For i = 1 To valores.Count
        If Val(Right(valores(i), 2)) < Val(Right(valor, 2)) Then
            valores.Add valor, Before:=i
            Exit Sub
        End If
    Next
    valores.Add valor
End Sub

:)
S aludos. D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
;)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas