Jump to content
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

Automatizar macro

Dranko

By Dranko
in Macros y programación VBA

Recommended Posts

Dranko Newbie

Dranko

Posted
Posted

Buenos días a todos,

veréis tengo una macro que me han dejado, que funciona correctamente, pero esta realizada de forma manual para 24 casillas y la necesitan para 300 casillas, con lo que realizar esto manualmente resulta un engorro.

Os cuento como funciona la macro (pestaña Secuencia):

En la casilla B11 se introduce el primer número, una vez introducido, automáticamente rellena las casilla D11, E11 y F11 con datos que recoge de la pestaña Color DB.

Se rellenan el resto de casillas de la columna B hasta la B35.

Una vez rellenados, se selecciona la opción secuencia y aquí es donde empieza todo. Lo que hace es mirar los valores de la fila 11 y los compara con todos los demás, hasta la fila 35. La diferencia de la comparación aparece en la columna H (H12 a H35).

El primero que ponemos en B11 lo pone automáticamente en B37, y a partir de la comparación de la columna H, el que tenga el valor más pequeño lo pone en la B38 (segundo de la lista).

Una vez lo pone como segundo de la lista (B38), ese número pasa a ser el que se pone en B11 y se realiza la comparación con los restantes, y así sucesivamente.

Mí pregunta es, ¿como puedo realizar esto automáticamente para 300 valores sin tener que hacer la macro 300 veces como hasta ahora?

El resultado, que empieza en la celda B37 se pueda cambiar, por ejemplo que empiece en la P11.

Muchas gracias y saludos.

Os adjunto el fichero y os pongo el código de la macro:



Sub Ordensectot()'

' Ordensectot Macro

' Macro grabada el 27/10/2010 por beprs

'



'

    ActiveSheet.Unprotect

    Range("B11").Select

    Selection.Copy

    Range("B37").Select

    ActiveSheet.Paste

    Range("B12:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H12"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B12").Select

    Selection.Copy

    Range("B38").Select

    ActiveSheet.Paste

    ActiveWindow.SmallScroll Down:=3

    Range("B38").Select

    Application.CutCopyMode = False

    Selection.Copy

    Range("B11").Select

    ActiveSheet.Paste

    Range("B13:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H13"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B13").Select

    Selection.Copy

    Range("B39").Select

    ActiveSheet.Paste

    Range("B39").Select

    Application.CutCopyMode = False

    Selection.Copy

    Range("B11").Select

    ActiveSheet.Paste

    Range("B14:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H14"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B14").Select

    Selection.Copy

    Range("B40").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    Range("B11").Select

    ActiveSheet.Paste

    Range("B15:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H15"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B15").Select

    Selection.Copy

    Range("B41").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    Range("B11").Select

    ActiveSheet.Paste

    Range("B16:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H16"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B16").Select

    Selection.Copy

    Range("B42").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    Range("B11").Select

    ActiveSheet.Paste

    Range("B17:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H17"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    ActiveWindow.SmallScroll Down:=3

    Range("B17").Select

    Selection.Copy

    Range("B43").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-6

    Range("B11").Select

    ActiveSheet.Paste

    ActiveWindow.SmallScroll Down:=3

    Range("B18:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H18"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B18").Select

    Selection.Copy

    ActiveWindow.SmallScroll Down:=6

    Range("B44").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-6

    Range("B11").Select

    ActiveSheet.Paste

    Range("B19:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H19"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    ActiveWindow.SmallScroll Down:=3

    Range("B19").Select

    Selection.Copy

    Range("B45").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-9

    Range("B11").Select

    ActiveSheet.Paste

    ActiveWindow.SmallScroll Down:=6

    Range("B20:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H20"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B20").Select

    ActiveWindow.SmallScroll Down:=6

    Selection.Copy

    Range("B46").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-9

    Range("B11").Select

    ActiveSheet.Paste

    Range("B21:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H21"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B21").Select

    ActiveWindow.SmallScroll Down:=12

    Selection.Copy

    Range("B47").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-12

    Range("B11").Select

    ActiveSheet.Paste

    Range("B22:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H22"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B22").Select

    ActiveWindow.SmallScroll Down:=9

    Selection.Copy

    ActiveWindow.SmallScroll Down:=9

    Range("B48").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-18

    Range("B11").Select

    ActiveSheet.Paste

    ActiveWindow.SmallScroll Down:=9

    Range("B23:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H23"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B23").Select

    Selection.Copy

    ActiveWindow.SmallScroll Down:=9

    Range("B49").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-21

    Range("B11").Select

    ActiveSheet.Paste

    ActiveWindow.SmallScroll Down:=15

    Range("B24:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H24"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B24").Select

    Selection.Copy

    Range("B50").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-21

    Range("B11").Select

    ActiveSheet.Paste

    ActiveWindow.SmallScroll Down:=15

    Range("B25:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H25"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B25").Select

    ActiveWindow.SmallScroll Down:=9

    Selection.Copy

    Range("B51").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-18

    Range("B11").Select

    ActiveSheet.Paste

    Range("B26:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H26"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B26").Select

    Selection.Copy

    ActiveWindow.SmallScroll Down:=18

    Range("B52").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-18

    Range("B11").Select

    ActiveSheet.Paste

    ActiveWindow.SmallScroll Down:=12

    Range("B27:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H27"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B27").Select

    Selection.Copy

    ActiveWindow.SmallScroll Down:=15

    Range("B53").Select

    ActiveSheet.Paste

    ActiveWindow.SmallScroll Down:=-24

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-6

    Range("B11").Select

    ActiveSheet.Paste

    ActiveWindow.SmallScroll Down:=18

    Range("B28:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H28"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B28").Select

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-18

    Range("B11").Select

    ActiveSheet.Paste

    ActiveWindow.SmallScroll Down:=18

    Application.CutCopyMode = False

    Selection.Copy

    Range("B54").Select

    ActiveSheet.Paste

    ActiveWindow.SmallScroll Down:=-3

    Range("B29:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H29"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B29").Select

    Selection.Copy

    ActiveWindow.SmallScroll Down:=9

    Range("B55").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-27

    Range("B11").Select

    ActiveSheet.Paste

    ActiveWindow.SmallScroll Down:=15

    Range("B30:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H30"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B30").Select

    Selection.Copy

    ActiveWindow.SmallScroll Down:=9

    Range("B56").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-18

    Range("B11").Select

    ActiveSheet.Paste

    ActiveWindow.SmallScroll Down:=9

    Range("B31:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H31"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B31").Select

    Selection.Copy

    ActiveWindow.SmallScroll Down:=15

    Range("B57").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-24

    Range("B11").Select

    ActiveSheet.Paste

    ActiveWindow.SmallScroll Down:=9

    Range("B32:H35").Select

    ActiveWindow.SmallScroll Down:=12

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H32"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B32").Select

    ActiveWindow.SmallScroll Down:=-3

    Selection.Copy

    ActiveWindow.SmallScroll Down:=9

    Range("B58").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-24

    Range("B11").Select

    ActiveSheet.Paste

    Range("B33:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H33"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B33").Select

    ActiveWindow.SmallScroll Down:=18

    Selection.Copy

    Range("B59").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-21

    Range("B11").Select

    ActiveSheet.Paste

    ActiveWindow.SmallScroll Down:=18

    Range("B34:H35").Select

    Application.CutCopyMode = False

    Selection.Sort Key1:=Range("H34"), Order1:=xlAscending, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

    Range("B34").Select

    Selection.Copy

    ActiveWindow.SmallScroll Down:=15

    Range("B60").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=-33

    Range("B11").Select

    ActiveSheet.Paste

    Range("B35:H35").Select

    ActiveWindow.SmallScroll Down:=12

    Range("B35").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveWindow.SmallScroll Down:=18

    Range("B61").Select

    ActiveSheet.Paste

    Range("B11:B35").Select

    Selection.ClearContents

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub



[/CODE]

Copia de COMPARATIVA COLORES (1).zip

Dranko Newbie

Dranko

Posted
  • Author
Posted
Hola:

He modificado la macro para adaptarla a cualquier número de colores en la columna "B", para eso he pasado los resultados a la columna "L".

A ver si es eso lo que querías.

Saludos

Muchas gracias por la ayuda!!

Esta genial el trabajo que has realizado, pero creo que el resultado da diferente a la macro que yo tengo, Introduciendo los valores en el mismo orden el resultado debería ser este (es decir, el resultado y lo que introducimos es lo mismo, ya que estos ya se encuentran ordenados):

[TABLE="width: 116"]

[TR]

[TD]100298[/TD]

[/TR]

[TR]

[TD]800152[/TD]

[/TR]

[TR]

[TD]200045[/TD]

[/TR]

[TR]

[TD]200741[/TD]

[/TR]

[TR]

[TD]300945[/TD]

[/TR]

[TR]

[TD]303035[/TD]

[/TR]

[TR]

[TD]300940[/TD]

[/TR]

[TR]

[TD]800149[/TD]

[/TR]

[TR]

[TD]901510[/TD]

[/TR]

[TR]

[TD]500390[/TD]

[/TR]

[TR]

[TD]500149[/TD]

[/TR]

[TR]

[TD]609617[/TD]

[/TR]

[TR]

[TD]600064[/TD]

[/TR]

[TR]

[TD]600141[/TD]

[/TR]

[TR]

[TD]600231[/TD]

[/TR]

[TR]

[TD]100772[/TD]

[/TR]

[TR]

[TD]100776[/TD]

[/TR]

[TR]

[TD]100356[/TD]

[/TR]

[TR]

[TD]101031[/TD]

[/TR]

[TR]

[TD]101092[/TD]

[/TR]

[TR]

[TD]300944[/TD]

[/TR]

[TR]

[TD]601020[/TD]

[/TR]

[TR]

[TD]500147[/TD]

[/TR]

[TR]

[TD]501280[/TD]

[/TR]

[TR]

[TD]500271[/TD]

[/TR]

[/TABLE]

[/CODE]

Y en cambio da esto:

[CODE][TABLE="width: 89"]
[TR]
[TD]100298[/TD]
[/TR]
[TR]
[TD]800152[/TD]
[/TR]
[TR]
[TD]200045[/TD]
[/TR]
[TR]
[TD]200741[/TD]
[/TR]
[TR]
[TD]101031[/TD]
[/TR]
[TR]
[TD]300940[/TD]
[/TR]
[TR]
[TD]300944[/TD]
[/TR]
[TR]
[TD]303035[/TD]
[/TR]
[TR]
[TD]101092[/TD]
[/TR]
[TR]
[TD]300945[/TD]
[/TR]
[TR]
[TD]800149[/TD]
[/TR]
[TR]
[TD]901510[/TD]
[/TR]
[TR]
[TD]500390[/TD]
[/TR]
[TR]
[TD]500149[/TD]
[/TR]
[TR]
[TD]100356[/TD]
[/TR]
[TR]
[TD]600231[/TD]
[/TR]
[TR]
[TD]100772[/TD]
[/TR]
[TR]
[TD]601020[/TD]
[/TR]
[TR]
[TD]100776[/TD]
[/TR]
[TR]
[TD]500147[/TD]
[/TR]
[TR]
[TD]609617[/TD]
[/TR]
[TR]
[TD]501280[/TD]
[/TR]
[TR]
[TD]500271[/TD]
[/TR]
[TR]
[TD]600064[/TD]
[/TR]
[TR]
[TD]600141[/TD]
[/TR]
[/TABLE]
[/CODE]

Repito, muchas gracias por tu ayuda!!

EDITO:

Por lo que he estado viendo, veo que el error esta en que sólo cambia el primer valor la primera vez, es decir, una vez analizada con el primer valor de la celda B11, cambia la celda B11 100298 por la 800152 y no lo vuelve ha hacer, y lo debe hacer cada vez que termina de analizar uno, no se si me explico. Es decir, se analiza uno y ese se quita, y el siguiente se compara con los que quedan, se van eliminando los analizados por así decirlo.

Muchas gracias de nuevo!!

EDITO 2:

Creo que ya lo tengo solucionado cambiando esta línea en la macro que me has pasado:

[CODE]If x > 11 Then Range("B" & x).Copy Range("B" & 11)[/CODE]

Archived

This topic is now archived and is closed to further replies.

Go to topic listing
×
×
  • Create New...

Important Information

Privacy Policy

  I accept