............ Foro Excel
Si no lo has hecho aún: REGISTRATE!!!

ME AYUDAIS CON ESTA FORMULA POR FAVOR

Ver el tema anterior Ver el tema siguiente Ir abajo

ME AYUDAIS CON ESTA FORMULA POR FAVOR

Mensaje por Invitado el Lun Sep 24, 2012 2:33 pm


Hola tengo Un libro Excel que me paso Icehell lo he modificado y no funciona bien.
El problema que tiene
Columna b tiene 11 números y debe tener 10 números
Columna k tiene 110 números y debe tener 40 números
El resto funciona bien os paso los datos para que lo podais revisar
Gracias de antemano



Sub reparto()

Dim nsort As New Collection, col2 As New Collection
Dim sort, n As Long

Application.ScreenUpdating = False

For n = 1 To 110
nsort.Add Worksheets("Hoja1").Range("K" & CStr(n)).Value
Next n

For n = nsort.Count To 1 Step -1
sort = Int(n * Rnd + 1)
col2.Add nsort(sort)
nsort.Remove sort
Next n

For n = 1 To col2.Count
Worksheets("Hoja1").Cells(n, 1) = col2(n)
Next n

Selection.Cut Destination:=Range("B1:B10")
Application.CutCopyMode = False
grupo2 = Range("A11:A20").Select
Selection.Cut Destination:=Range("B1:B10")
Application.CutCopyMode = False
grupo3 = Range("A21:A30").Select
Selection.Cut Destination:=Range("C1:C10")
Application.CutCopyMode = False
grupo4 = Range("A31:A40").Select
Selection.Cut Destination:=Range("D1:D10")
Application.CutCopyMode = False
grupo5 = Range("A41:A50").Select
Selection.Cut Destination:=Range("E1:E10")
Application.CutCopyMode = False
grupo6 = Range("A51:A60").Select
Selection.Cut Destination:=Range("F1:F10")
Application.CutCopyMode = False
grupo7 = Range("A61:A70").Select
Selection.Cut Destination:=Range("G1:G10")
Application.CutCopyMode = False
Grupo8 = Range("A71:A80").Select
Selection.Cut Destination:=Range("H1:H10")
Application.CutCopyMode = False
grupo9 = Range("A81:A90").Select
Selection.Cut Destination:=Range("I1:I10")
Application.CutCopyMode = False
grupo10 = Range("A91:A100").Select
Selection.Cut Destination:=Range("J1:J10")
Application.CutCopyMode = False



Range("K1").Select

Application.ScreenUpdating = True

End Sub

Invitado
Invitado


Volver arriba Ir abajo

Re: ME AYUDAIS CON ESTA FORMULA POR FAVOR

Mensaje por icehell el Lun Sep 24, 2012 7:38 pm

Como mi última solución a tu problema, tanto este como el anterior tema creado para lo mismo te paso este archivo que sigue sin converserme de que sea lo que necesitas pero quizás lo entiendas mejor ahora.

Y en cuanto al código anterior tienes que cambiar la línea
For n = 1 To 110
por

Código:
For n = 1 To 40
No veo que la columna B arroje 11 números.
Archivos
Reparto en grupos.xls No tienes los permisos para descargar los archivos.(50 KB) Descargado 9 veces

icehell

Masculino Cantidad de envíos : 64
Edad : 42
Ciudad - Pais : Arrecife
Version de Excel : 2010
Fecha de inscripción : 26/11/2010

http://icehellsoftware.260mb.org/

Volver arriba Ir abajo

Re: ME AYUDAIS CON ESTA FORMULA POR FAVOR

Mensaje por Invitado el Lun Sep 24, 2012 8:52 pm

Gracias icehell por ayudarme pero en el archivo que me mandaste de repartos
Tiene 4 columnas a, b, c, d, yo la he modificado por mu cuenta
y he conseguido 10 columnas a,b,c,d,e,f,g,h,i,j, y la columna k tengo puestos 110 números para que llene la tabla de Excel
Pero yo necesito solo 40 y que reparta en las 10 columnas
Y la columna b tiene 11 números
Me podrías ayudar a corregir la columna B y columna k a que tenga solo 40 números y rellene las 10 columnas gracias.
Te mando el código de la página para que veas lo que te digo


Sub reparto()

Dim nsort As New Collection, col2 As New Collection
Dim sort, n As Long

Application.ScreenUpdating = False

For n = 1 To 110
nsort.Add Worksheets("Hoja1").Range("K" & CStr(n)).Value
Next n

For n = nsort.Count To 1 Step -1
sort = Int(n * Rnd + 1)
col2.Add nsort(sort)
nsort.Remove sort
Next n

For n = 1 To col2.Count
Worksheets("Hoja1").Cells(n, 1) = col2(n)
Next n

Selection.Cut Destination:=Range("B1:B10")
Application.CutCopyMode = False
grupo2 = Range("A11:A20").Select
Selection.Cut Destination:=Range("B1:B10")
Application.CutCopyMode = False
grupo3 = Range("A21:A30").Select
Selection.Cut Destination:=Range("C1:C10")
Application.CutCopyMode = False
grupo4 = Range("A31:A40").Select
Selection.Cut Destination:=Range("D1:D10")
Application.CutCopyMode = False
grupo5 = Range("A41:A50").Select
Selection.Cut Destination:=Range("E1:E10")
Application.CutCopyMode = False
grupo6 = Range("A51:A60").Select
Selection.Cut Destination:=Range("F1:F10")
Application.CutCopyMode = False
grupo7 = Range("A61:A70").Select
Selection.Cut Destination:=Range("G1:G10")
Application.CutCopyMode = False
Grupo8 = Range("A71:A80").Select
Selection.Cut Destination:=Range("H1:H10")
Application.CutCopyMode = False
grupo9 = Range("A81:A90").Select
Selection.Cut Destination:=Range("I1:I10")
Application.CutCopyMode = False
grupo10 = Range("A91:A100").Select
Selection.Cut Destination:=Range("J1:J10")
Application.CutCopyMode = False



Range("K1").Select

Application.ScreenUpdating = True

End Sub

Invitado
Invitado


Volver arriba Ir abajo

Re: ME AYUDAIS CON ESTA FORMULA POR FAVOR

Mensaje por Contenido patrocinado Hoy a las 12:39 pm


Contenido patrocinado


Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.